Theory QE

section "QE lemmas"
theory QE
  imports Polynomials.MPoly_Type_Univariate
    Polynomials.Polynomials  Polynomials.MPoly_Type_Class_FMap 
    "HOL-Library.Quadratic_Discriminant"
begin

(* This file may take some time to load *)

subsection "Useful Definitions/Setting Up"

definition sign:: "real Polynomial.poly ⇒ real ⇒ int"
  where "sign p x ≡ (if poly p x = 0 then 0 else (if poly p x > 0 then 1 else -1))"

definition sign_num:: "real ⇒ int"
  where "sign_num x ≡ (if x = 0 then 0 else (if x > 0 then 1 else -1))"

definition root_list:: "real Polynomial.poly ⇒ real set"
  where "root_list p ≡ ({(x::real). poly p x = 0}::real set)" 

definition root_set:: "(real × real × real) set ⇒ real set"
  where "root_set les ≡ ({(x::real). (∃ (a, b, c) ∈ les. a*x^2 + b*x + c = 0)}::real set)" 

definition sorted_root_list_set:: "(real × real × real) set ⇒ real list"
  where "sorted_root_list_set p ≡ sorted_list_of_set (root_set p)" 

definition nonzero_root_set:: "(real × real × real) set ⇒ real set"
  where "nonzero_root_set les ≡ ({(x::real). (∃ (a, b, c) ∈ les. (a ≠ 0 ∨ b ≠ 0) ∧ a*x^2 + b*x + c = 0)}::real set)" 

definition sorted_nonzero_root_list_set:: "(real × real × real) set ⇒ real list"
  where "sorted_nonzero_root_list_set p ≡ sorted_list_of_set (nonzero_root_set p)" 


(* Important property of sorted lists *)
lemma sorted_list_prop:
  fixes l::"real list"
  fixes x::"real"
  assumes sorted: "sorted l"
  assumes lengt: "length l > 0"
  assumes xgt: "x > l ! 0"
  assumes xlt: "x ≤ l ! (length l - 1)"
  shows "∃n. (n+1) < (length l) ∧ x ≥ l !n ∧ x ≤ l ! (n + 1)"
proof - 
  have "¬(∃n. (n+1) < (length l) ∧ x ≥ l !n ∧ x ≤ l ! (n + 1)) ⟹ False"
  proof clarsimp 
    fix n
    assume alln: "∀n. l ! n ≤ x ⟶ Suc n < length l ⟶ ¬ x ≤ l ! Suc n"
    have "∀k. (k < length l ⟶ x > l ! k)" 
    proof clarsimp 
      fix k
      show "k < length l ⟹ l ! k < x"
      proof (induct k)
        case 0
        then show ?case using xgt by auto
      next
        case (Suc k)
        then show ?case using alln
          using less_eq_real_def by auto 
      qed
    qed
    then show "False"
      using xlt diff_Suc_less lengt not_less
      by (metis One_nat_def) 
  qed
  then show ?thesis by auto
qed


subsection "Quadratic polynomial properties"
lemma quadratic_poly_eval: 
  fixes a b c::"real"
  fixes x::"real"
  shows "poly [:c, b, a:] x = a*x^2 + b*x + c"    
proof - 
  have "x * (b + x * a) = a * x2 + b * x" by (metis add.commute distrib_right mult.assoc mult.commute power2_eq_square)
  then show ?thesis by auto
qed

lemma poly_roots_set_same:
  fixes a b c:: "real"
  shows "{(x::real). a * x2 + b * x + c = 0} = {x. poly [:c, b, a:] x = 0}"
proof - 
  have "∀x. a*x^2 + b*x + c = poly [:c, b, a:] x"
  proof clarsimp 
    fix x
    show "a * x2 + b * x = x * (b + x * a)"
      using quadratic_poly_eval[of c b a x] by auto
  qed
  then show ?thesis 
    by auto
qed

lemma root_set_finite:
  assumes fin: "finite les"
  assumes nex: "¬(∃ (a, b, c) ∈ les. a = 0 ∧ b = 0 ∧ c = 0 )"
  shows "finite (root_set les)"
proof - 
  have "∀(a, b, c) ∈ les. finite {(x::real). a*x^2 + b*x + c = 0}" 
  proof clarsimp 
    fix a b c
    assume "(a, b, c) ∈ les"
    then have "[:c, b, a:] ≠ 0" using nex by auto
    then have "finite {x. poly [:c, b, a:] x = 0}"
      using poly_roots_finite[where p = "[:c, b, a:]"] by auto
    then show "finite {x. a * x2 + b * x + c = 0}"
      using  poly_roots_set_same by auto
  qed
  then show ?thesis using fin
    unfolding root_set_def by auto
qed

lemma nonzero_root_set_finite:
  assumes fin: "finite les"
  shows "finite (nonzero_root_set les)"
proof - 
  have "∀(a, b, c) ∈ les. (a ≠ 0 ∨ b ≠ 0) ⟶ finite {(x::real). a*x^2 + b*x + c = 0}" 
  proof clarsimp 
    fix a b c
    assume ins: "(a, b, c) ∈ les"
    assume "a = 0 ⟶ b ≠ 0"
    then have "[:c, b, a:] ≠ 0" using ins by auto
    then have "finite {x. poly [:c, b, a:] x = 0}"
      using poly_roots_finite[where p = "[:c, b, a:]"] by auto
    then show "finite {x. a * x2 + b * x + c = 0}"
      using  poly_roots_set_same by auto
  qed
  then show ?thesis using fin
    unfolding nonzero_root_set_def by auto
qed

lemma discriminant_lemma:
  fixes a b c r::"real"
  assumes aneq: "a ≠ 0"
  assumes beq: "b = 2 * a * r"
  assumes root: " a * r^2 - 2 * a * r*r + c = 0"
  shows "∀x. a * x2 + b * x + c = 0 ⟷ x = -r"
proof - 
  have "c = a*r^2" using root
    by (simp add: power2_eq_square)
  then have same: "b^2 - 4*a*c = (2 * a * r)^2 - 4*a*(a*r^2)" using beq
    by blast 
  have "(2 * a * r)^2 = 4*a^2*r^2"
    by (simp add: mult.commute power2_eq_square)
  then have "(2 * a * r)^2 - 4*a*(a*(r)^2) = 0"
    using power2_eq_square by auto 
  then have "b^2 - 4*a*c = 0" using same
    by simp 
  then have "∀x. a * x2 + b * x + c = 0 ⟷ x = -b / (2 * a)"
    using discriminant_zero aneq unfolding discrim_def by auto
  then show ?thesis using beq
    by (simp add: aneq) 
qed

(* Show a polynomial only changes sign when it passes through a root *)
lemma changes_sign:
  fixes p:: "real Polynomial.poly"
  shows "∀x::real. ∀ y::real. ((sign p x ≠ sign p y  ∧ x < y) ⟶ (∃c ∈ (root_list p). x ≤ c ∧ c ≤ y))"
proof clarsimp
  fix x y
  assume "sign p x ≠ sign p y"
  assume "x < y"
  then show "∃c∈root_list p. x ≤ c ∧ c ≤ y"
    using poly_IVT_pos[of x y p] poly_IVT_neg[of x y p] 
    by (metis (mono_tags) ‹sign p x ≠ sign p y› less_eq_real_def linorder_neqE_linordered_idom mem_Collect_eq root_list_def sign_def)
qed

(* Show a polynomial only changes sign if it passes through a root *)
lemma changes_sign_var:
  fixes a b c x y:: "real"
  shows "((sign_num (a*x^2 + b*x + c) ≠ sign_num (a*y^2 + b*y + c)  ∧ x < y) ⟹ (∃q. (a*q^2 + b*q + c = 0 ∧ x ≤ q ∧ q ≤ y)))"
proof  clarsimp
  assume sn: "sign_num (a * x2 + b * x + c) ≠ sign_num (a * y2 + b * y + c)"
  assume xy: " x < y"
  let ?p = "[:c, b, a:]"
  have cs: "((sign ?p x ≠ sign ?p y  ∧ x < y) ⟶ (∃c ∈ (root_list ?p). x ≤ c ∧ c ≤ y))"
    using changes_sign[of ?p] by auto
  have "(sign ?p x ≠ sign ?p y  ∧ x < y)"
    using sn xy unfolding sign_def sign_num_def using quadratic_poly_eval
    by presburger 
  then have "(∃c ∈ (root_list ?p). x ≤ c ∧ c ≤ y)" 
    using cs 
    by auto 
  then obtain q where "q ∈ root_list ?p ∧ x ≤ q ∧ q ≤ y" 
    by auto
  then have "a*q^2 + b*q + c = 0 ∧ x ≤ q ∧ q ≤ y"
    unfolding root_list_def using quadratic_poly_eval[of c b a q]
    by auto
  then show "∃q. a * q2 + b * q + c = 0 ∧ x ≤ q ∧ q ≤ y"  
    by auto
qed

subsection "Continuity Properties"
lemma continuity_lem_eq0:
  fixes p::"real"
  shows "r < p ⟹ ∀x∈{r <..p}. a * x2 + b * x + c = 0 ⟹ (a = 0 ∧ b = 0 ∧ c = 0)" 
proof - 
  assume r_lt: "r < p"
  assume inf_zer: "∀x∈{r <..p}. a * x2 + b * x + c = 0"
  have nf: "¬finite {r..<p}" using Set_Interval.dense_linorder_class.infinite_Ioo r_lt by auto
  have "¬(a = 0 ∧ b = 0 ∧ c = 0) ⟹ False"
  proof - 
    assume "¬(a = 0 ∧ b = 0 ∧ c = 0)"
    then have "[:c, b, a:] ≠ 0" by auto
    then have fin: "finite {x. poly [:c, b, a:] x = 0}" using poly_roots_finite[where p = "[:c, b, a:]"] by auto
    have "{x. a*x^2 + b*x + c = 0} = {x. poly [:c, b, a:] x = 0}" using quadratic_poly_eval by auto
    then have finset: "finite {x. a*x^2 + b*x + c = 0}"  using fin by auto
    have "{r <..p} ⊆ {x. a*x^2 + b*x + c = 0}" using inf_zer by blast
    then show "False" using finset nf
      using finite_subset
      by (metis (no_types, lifting) infinite_Ioc_iff r_lt) 
  qed
  then show "(a = 0 ∧ b = 0 ∧ c = 0)" by auto
qed

lemma continuity_lem_lt0: 
  fixes r:: "real"
  fixes a b c:: "real"
  shows "poly [:c, b, a:] r < 0 ⟹
    ∃y'> r. ∀x∈{r<..y'}. poly [:c, b, a:] x < 0"
proof - 
  let ?f = "poly [:c,b,a:]"
  assume r_ltz: "poly [:c, b, a:] r < 0"
  then have "[:c, b, a:] ≠ 0" by auto
  then have "finite {x. poly [:c, b, a:] x = 0}" using poly_roots_finite[where p = "[:c, b, a:]"]    
    by auto
  then have fin: "finite  {x. x > r ∧ poly [:c, b, a:] x = 0}"
    using finite_Collect_conjI by blast 
  let ?l = "sorted_list_of_set {x. x > r ∧ poly [:c, b, a:] x = 0}"
  show ?thesis proof (cases "length ?l = 0")
    case True
    then have no_zer: "¬(∃x>r. poly [:c, b, a:] x = 0)" using sorted_list_of_set_eq_Nil_iff fin by auto
    then have "⋀y. y > r ∧ y < (r + 1) ⟹ poly [:c, b, a:] y < 0 " 
    proof - 
      fix y
      assume "y > r ∧ y < r + 1"
      then show "poly [:c, b, a:] y < 0"
        using r_ltz no_zer poly_IVT_pos[where a = "r", where p = "[:c, b, a:]", where b = "y"]
        by (meson linorder_neqE_linordered_idom)
    qed
    then show ?thesis
      by (metis (no_types, hide_lams) ‹¬ (∃x>r. poly [:c, b, a:] x = 0)› ‹poly [:c, b, a:] r < 0› greaterThanAtMost_iff linorder_neqE_linordered_idom linordered_field_no_ub poly_IVT_pos) 
  next
    case False
    then have len_nonz: "length (sorted_list_of_set {x. r < x ∧ poly [:c, b, a:] x = 0}) ≠ 0"
      by blast 
    then have "∀n ∈ {x. x > r ∧ poly [:c, b, a:] x = 0}. (nth_default 0 ?l 0) ≤ n"
      using fin set_sorted_list_of_set sorted_sorted_list_of_set
      using  in_set_conv_nth leI not_less0 sorted_nth_mono
      by (smt not_less_iff_gr_or_eq nth_default_def)
    then have no_zer: "¬(∃x>r. (x < (nth_default 0 ?l 0) ∧ poly [:c, b, a:] x = 0))"
      using sorted_sorted_list_of_set by auto
    then have fa: "⋀y. y > r ∧ y < (nth_default 0 ?l 0) ⟹ poly [:c, b, a:] y < 0 " 
    proof - 
      fix y
      assume "y > r ∧ y < (nth_default 0 ?l 0)"
      then show "poly [:c, b, a:] y < 0"
        using r_ltz no_zer poly_IVT_pos[where a = "r", where p = "[:c, b, a:]", where b = "y"]
        by (meson less_imp_le less_le_trans linorder_neqE_linordered_idom)
    qed
    have "nth_default 0 ?l 0 > r" using fin set_sorted_list_of_set
      using len_nonz length_0_conv length_greater_0_conv mem_Collect_eq nth_mem
      by (metis (no_types, lifting) nth_default_def)
    then have "∃(y'::real). r < y' ∧ y' < (nth_default 0 ?l 0)"
      using dense by blast
    then obtain y' where y_prop:"r < y' ∧y' < (nth_default 0 ?l 0)" by auto
    then have "∀x∈{r<..y'}. poly [:c, b, a:] x < 0"
      using fa by auto
    then show ?thesis using y_prop by blast 
  qed
qed

lemma continuity_lem_gt0: 
  fixes r:: "real"
  fixes a b c:: "real"
  shows "poly [:c, b, a:] r > 0 ⟹
    ∃y'> r. ∀x∈{r<..y'}. poly [:c, b, a:] x > 0"
proof -
  assume r_gtz: "poly [:c, b, a:] r > 0 "
  let ?p = "[:-c, -b, -a:]"
  have revpoly: "∀x. -1*(poly [:c, b, a:] x) = poly [:-c, -b, -a:] x"
    by (metis (no_types, hide_lams) Polynomial.poly_minus add.inverse_neutral minus_pCons mult_minus1)
  then have "poly ?p r < 0" using r_gtz
    by (metis mult_minus1 neg_less_0_iff_less)
  then have "∃y'> r. ∀x∈{r<..y'}. poly ?p x < 0" using continuity_lem_lt0
    by blast
  then obtain y' where y_prop: "y' > r ∧ (∀x∈{r<..y'}. poly ?p x < 0)" by auto
  then have "∀x∈{r<..y'}. poly [:c, b, a:] x > 0 " using revpoly
    using neg_less_0_iff_less by fastforce
  then show ?thesis 
    using y_prop  by blast 
qed

lemma continuity_lem_lt0_expanded: 
  fixes r:: "real"
  fixes a b c:: "real"
  shows "a*r^2 + b*r + c < 0 ⟹
    ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c < 0"
  using quadratic_poly_eval continuity_lem_lt0 
  by (simp add: add.commute) 

lemma continuity_lem_gt0_expanded: 
  fixes r:: "real"
  fixes a b c:: "real"
  fixes k::"real"
  assumes kgt: "k > r"
  shows "a*r^2 + b*r + c > 0 ⟹
    ∃x∈{r<..k}. a*x^2 + b*x + c > 0"
proof -
  assume "a*r^2 + b*r + c > 0"
  then have "∃y'> r. ∀x∈{r<..y'}. poly [:c, b, a:] x > 0"
    using continuity_lem_gt0 quadratic_poly_eval[of c b a r] by auto 
  then obtain y' where y_prop: "y' > r ∧ (∀x∈{r<..y'}. poly [:c, b, a:] x > 0)" by auto
  then have "∃q. q > r ∧ q < min k y'" using kgt dense
    by (metis min_less_iff_conj)   
  then obtain q where q_prop: "q > r ∧q < min k y'" by auto
  then have "a*q^2 + b*q + c > 0" using y_prop  quadratic_poly_eval[of c b a q]
    by (metis greaterThanAtMost_iff less_eq_real_def min_less_iff_conj)
  then show ?thesis
    using q_prop by auto
qed

subsection "Negative Infinity (Limit) Properties"

lemma ysq_dom_y: 
  fixes b:: "real"
  fixes c:: "real"
  shows "∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)"
proof - 
  have c1: "b ≥ 0 ==> ∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)"
  proof - 
    assume "b ≥ 0"
    then have p1: "∀(y:: real). (y < -1 ⟶ y*b ≤ 0)"
      by (simp add: mult_nonneg_nonpos2)
    have p2: "∀(y:: real). (y < -1 ⟶ y^2 > 0)"
      by auto 
    then have h1: "∀(y:: real). (y < -1 ⟶ y^2 > b*y)"  
      using p1 p2
      by (metis less_eq_real_def less_le_trans mult.commute) 
    then show ?thesis by auto
  qed
  have c2: "b < 0 ∧ b > -1 ==> ∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)"
  proof - 
    assume "b < 0 ∧ b > -1 "
    then have h1: "∀(y:: real). (y < -1 ⟶ y^2 > b*y)"
      by (simp add: power2_eq_square)  
    then show ?thesis by auto
  qed   
  have c3: "b ≤ -1 ==> ∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)"
  proof - 
    assume "b ≤ -1 "
    then have h1: "∀(y:: real). (y < b ⟶ y^2 > b*y)"
      by (metis le_minus_one_simps(3) less_irrefl less_le_trans mult.commute mult_less_cancel_left power2_eq_square)
    then show ?thesis by auto
  qed   
  then  show ?thesis using c1 c2 c3
    by (metis less_trans linorder_not_less) 
qed

lemma ysq_dom_y_plus_coeff: 
  fixes b:: "real"
  fixes c:: "real"
  shows "∃(w::real). ∀(y::real). (y < w ⟶ y^2 > b*y + c)"
proof - 
  have "∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)" using ysq_dom_y by auto
  then obtain w where w_prop: "∀(y:: real). (y < w ⟶ y^2 > b*y)" by auto
  have "c ≤ 0 ⟹  ∀(y::real). (y < w ⟶ y^2 > b*y + c)"
    using w_prop by auto 
  then have c1: "c ≤ 0 ⟹ ∃(w::real). ∀(y::real). (y < w ⟶ y^2 > b*y + c)" by auto
  have "∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > (b-c)*y)" using ysq_dom_y by auto
  then obtain k where k_prop: "∀(y:: real). (y < k ⟶ y^2 > (b-c)*y)" by auto
  let ?mn = "min k (-1)"
  have "(c> 0 ⟹ (∀ y < -1. -c*y > c))" 
  proof - 
    assume cgt: " c> 0"
    show "∀(y::real) < -1. -c*y > c"
    proof clarsimp
      fix y::"real"
      assume "y < -1"
      then have "-y > 1"
        by auto
      then have "c < c*(-y)" using cgt 
        by (metis ‹1 < - y› mult.right_neutral mult_less_cancel_left_pos)
      then show " c < - (c * y) "
        by auto
    qed
  qed
  then have "(c> 0 ⟶ (∀ y < ?mn. (b-c)*y > b*y + c))" 
    by (simp add: left_diff_distrib) 
  then have c2:  "c > 0 ⟹  ∀(y::real). (y < ?mn ⟶ y^2 > b*y + c)"
    using k_prop
    by force
  then have c2:  "c > 0 ⟹ ∃(w::real). ∀(y::real). (y < w ⟶ y^2 > b*y + c)"
    by blast
  show ?thesis using c1 c2
    by fastforce
qed

lemma ysq_dom_y_plus_coeff_2: 
  fixes b:: "real"
  fixes c:: "real"
  shows "∃(w::real). ∀(y::real). (y > w ⟶ y^2 > b*y + c)"
proof - 
  have "∃(w::real). ∀(y::real). (y < w ⟶ y^2 > -b*y + c)"
    using ysq_dom_y_plus_coeff[where b = "-b", where c = "c"] by auto
  then obtain w where w_prop: "∀(y::real). (y < w ⟶ y^2 > -b*y + c)" by auto
  let ?mn = "min w (-1)"
  have "∀(y::real). (y < ?mn ⟶ y^2 > -b*y + c)" using w_prop by auto
  then have "∀(y::real). (y > (-1*?mn) ⟶ y^2 > b*y + c)"
    by (metis (no_types, hide_lams) add.inverse_inverse minus_less_iff mult_minus1 mult_minus_left mult_minus_right power2_eq_square) 
  then show ?thesis by auto
qed

lemma neg_lc_dom_quad: 
  fixes a:: "real"
  fixes b:: "real"
  fixes c:: "real"
  assumes alt: "a < 0"
  shows "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c < 0)"
proof -
  have "∃(w::real). ∀(y::real). (y > w ⟶ y^2 > (-b/a)*y + (-c/a))"
    using ysq_dom_y_plus_coeff_2[where b = "-b/a", where c = "-c/a"] by auto
  then have keyh: "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 < a*((-b/a)*y + (-c/a)))"
    using alt by auto
  have simp1: "∀y. a*((-b/a)*y + (-c/a)) = a*(-b/a)*y + a*(-c/a)"
    using diff_divide_eq_iff by fastforce
  have simp2: "∀y. a*(-b/a)*y + a*(-c/a) = -b*y + a*(-c/a)"
    using assms by auto
  have simp3: "∀y. -b*y + a*(-c/a) = -b*y - c"
    using assms by auto
  then have "∀y. a*((-b/a)*y + (-c/a)) = -b*y - c" using simp1 simp2 simp3 by auto
  then have keyh2: "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 < -b*y-c)"
    using keyh by auto
  have "∀y. a*y^2 < -b*y-c ⟷ a*y^2 + b*y + c < 0" by auto
  then show ?thesis using keyh2 by auto
qed

lemma pos_lc_dom_quad: 
  fixes a:: "real"
  fixes b:: "real"
  fixes c:: "real"
  assumes alt: "a > 0"
  shows "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)"
proof -
  have "-a < 0" using alt
    by simp 
  then have "∃(w::real). ∀(y::real). (y > w ⟶ -a*y^2 - b*y - c < 0)"
    using neg_lc_dom_quad[where a = "-a", where b = "-b", where c = "-c"] by auto
  then obtain w where w_prop: "∀(y::real). (y > w ⟶ -a*y^2 - b*y - c < 0)" by auto
  then have "∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)"
    by auto
  then show ?thesis by auto
qed

(* lemma interval_infinite: 
  fixes r p::"real"
  assumes "r < p"
  shows "infinite {r<..<p}"
  using Set_Interval.dense_linorder_class.infinite_Ioo using assms by blast 
*)

subsection "Infinitesimal and Continuity Properties"
lemma les_qe_inf_helper: 
  fixes q:: "real"
  shows"(∀(d, e, f)∈set les. ∃y'> q. ∀x∈{q<..y'}. d * x2 + e * x + f < 0) ⟹ 
    (∃y'>q. (∀(d, e, f)∈set les. ∀x∈{q<..y'}. d * x2 + e * x + f < 0))"
proof (induct les)
  case Nil
  then show ?case using gt_ex by auto 
next
  case (Cons z les)
  have "∀a∈set les. case a of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x2 + e * x + f < 0"
    using  Cons.prems by auto
  then have " ∃y'>q. ∀a∈set les. case a of (d, e, f) ⇒ ∀x∈{q<..y'}. d * x2 + e * x + f < 0"
    using Cons.hyps by auto
  then obtain y1 where y1_prop : "y1>q ∧ (∀a∈set les. case a of (d, e, f) ⇒ ∀x∈{q<..y1}. d * x2 + e * x + f < 0)"
    by auto
  have "case z of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x2 + e * x + f < 0"
    using Cons.prems by auto
  then obtain y2 where y2_prop: "y2>q ∧ (case z of (d, e, f) ⇒ (∀x∈{q<..y2}. d * x2 + e * x + f < 0))"
    by auto
  let ?y = "min y1 y2"
  have "?y > q ∧ (∀a∈set (z#les). case a of (d, e, f) ⇒ ∀x∈{q<..?y}. d * x2 + e * x + f < 0)"
    using y1_prop y2_prop
    by force
  then show ?case
    by blast
qed 

lemma have_inbetween_point_les:
  fixes r::"real"
  assumes "(∀(d, e, f)∈set les. ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0)"
  shows "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
proof -
  have "(∀(d, e, f)∈set les. ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ⟹ 
    (∃y'>r. (∀(d, e, f)∈set les. ∀x∈{r<..y'}. d * x2 + e * x + f < 0))"
    using les_qe_inf_helper assms by auto
  then have "(∃y'>r. (∀(d, e, f)∈set les. ∀x∈{r<..y'}. d * x2 + e * x + f < 0))"
    using assms
    by blast 
  then obtain y where y_prop: "y > r ∧  (∀(d, e, f)∈set les. ∀x∈{r<..y}. d * x2 + e * x + f < 0)"
    by auto
  have "∃q. q >  r ∧q < y" using y_prop dense by auto
  then obtain q where q_prop: "q > r ∧ q < y" by auto
  then have "(∀(d, e, f)∈set les. d*q^2 + e*q + f < 0)"
    using y_prop by auto
  then show ?thesis
    by auto
qed

lemma one_root_a_gt0: 
  fixes a b c r:: "real"
  shows "⋀y'. b = 2 * a * r ⟹
          ¬ a < 0 ⟹
          a * r^2 - 2 * a *r*r + c = 0 ⟹
          - r < y' ⟹
          ∃x∈{-r<..y'}. ¬ a * x2 + 2 * a * r*x + c < 0"
proof - 
  fix y'
  assume beq: "b = 2 * a * r"
  assume aprop: " ¬ a < 0"
  assume root: " a * r2 - 2 * a *r*r + c = 0"
  assume rootlt: "- r < y'"
  show " ∃x∈{- r<..y'}. ¬ a * x2 + 2 * a* r*x+ c < 0"
  proof - 
    have h: "a = 0 ⟹ (b = 0 ∧ c = 0)" using beq root   
      by auto
    then have aeq: "a = 0 ⟹ ∃x∈{- r<..y'}. ¬ a * x2 + 2 * a*r*x + c < 0"
      using rootlt
      by (metis add.left_neutral continuity_lem_eq0 less_numeral_extra(3) mult_zero_left mult_zero_right) 
    then have alt: "a > 0 ⟹ ∃x∈{- r<..y'}. ¬ a * x2 + 2 * a *r*x + c < 0"
    proof - 
      assume agt: "a > 0"
      then have "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)"
        using pos_lc_dom_quad by auto
      then obtain w where w_prop: "∀y::real. (y > w ⟶ a*y^2 + b*y + c > 0)" by auto
      have isroot: "a*(-r)^2 + b*(-r) + c = 0" using root beq by auto
      then have wgteq: "w ≥ -(r)"
      proof -
        have "w < -r ⟹ False"
          using w_prop isroot by auto
        then show ?thesis
          using not_less by blast 
      qed
      then have w1: "w + 1 > -r"
        by auto 
      have w2: "a*(w + 1)^2 + b*(w+1) + c > 0" using w_prop by auto
      have rootiff: "∀x. a * x2 + b * x + c = 0 ⟷ x = -r" using  discriminant_lemma[where a = "a", where b = "b", where c= "c", where r = "r"]
          isroot agt beq by auto
      have allgt: "∀x > -r. a*x^2 + b*x + c > 0"
      proof clarsimp 
        fix x
        assume "x > -r"
        have xgtw:  "x > w + 1 ⟹ a*x^2 + b*x + c > 0 "
          using w1 w2 rootiff  poly_IVT_neg[where a = "w+1", where b = "x", where p = "[:c,b,a:]"] 
            quadratic_poly_eval
          by (metis less_eq_real_def linorder_not_less) 
        have xltw: "x < w + 1 ⟹ a*x^2 + b*x + c > 0"
          using w1 w2 rootiff poly_IVT_pos[where a= "x", where b = "w + 1", where p = "[:c,b,a:]"]
            quadratic_poly_eval less_eq_real_def linorder_not_less
          by (metis ‹- r < x›)
        then show "a*x^2 + b*x + c > 0"
          using w2 xgtw xltw by fastforce 
      qed
      have "∃z. z > -r ∧ z < y'" using rootlt dense[where x = "-r", where y = "y'"] 
        by auto
      then obtain z where z_prop: " z > -r ∧ z  < y'" by auto
      then have "a*z^2 + b*z + c > 0" using allgt by auto
      then show ?thesis using z_prop
        using beq greaterThanAtMost_iff by force 
    qed
    then show ?thesis using aeq alt aprop
      by linarith
  qed
qed

lemma leq_qe_inf_helper: 
  fixes q:: "real"
  shows"(∀(d, e, f)∈set leq. ∃y'> q. ∀x∈{q<..y'}. d * x2 + e * x + f ≤ 0) ⟹ 
    (∃y'>q. (∀(d, e, f)∈set leq. ∀x∈{q<..y'}. d * x2 + e * x + f ≤ 0))"
proof (induct leq)
  case Nil
  then show ?case using gt_ex by auto 
next
  case (Cons z leq)
  have "∀a∈set leq. case a of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x2 + e * x + f ≤ 0"
    using  Cons.prems by auto
  then have " ∃y'>q. ∀a∈set leq. case a of (d, e, f) ⇒ ∀x∈{q<..y'}. d * x2 + e * x + f ≤ 0"
    using Cons.hyps by auto
  then obtain y1 where y1_prop : "y1>q ∧ (∀a∈set leq. case a of (d, e, f) ⇒ ∀x∈{q<..y1}. d * x2 + e * x + f ≤ 0)"
    by auto
  have "case z of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x2 + e * x + f ≤ 0"
    using Cons.prems by auto
  then obtain y2 where y2_prop: "y2>q ∧ (case z of (d, e, f) ⇒ (∀x∈{q<..y2}. d * x2 + e * x + f ≤ 0))"
    by auto
  let ?y = "min y1 y2"
  have "?y > q ∧ (∀a∈set (z#leq). case a of (d, e, f) ⇒ ∀x∈{q<..?y}. d * x2 + e * x + f ≤ 0)"
    using y1_prop y2_prop
    by force
  then show ?case
    by blast
qed 

lemma neq_qe_inf_helper: 
  fixes q:: "real"
  shows"(∀(d, e, f)∈set neq. ∃y'> q. ∀x∈{q<..y'}. d * x2 + e * x + f ≠ 0) ⟹ 
    (∃y'>q. (∀(d, e, f)∈set neq. ∀x∈{q<..y'}. d * x2 + e * x + f ≠ 0))"
proof (induct neq)
  case Nil
  then show ?case using gt_ex by auto 
next
  case (Cons z neq)
  have "∀a∈set neq. case a of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x2 + e * x + f ≠ 0"
    using  Cons.prems by auto
  then have " ∃y'>q. ∀a∈set neq. case a of (d, e, f) ⇒ ∀x∈{q<..y'}. d * x2 + e * x + f ≠ 0"
    using Cons.hyps by auto
  then obtain y1 where y1_prop : "y1>q ∧ (∀a∈set neq. case a of (d, e, f) ⇒ ∀x∈{q<..y1}. d * x2 + e * x + f ≠ 0)"
    by auto
  have "case z of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x2 + e * x + f ≠ 0"
    using Cons.prems by auto
  then obtain y2 where y2_prop: "y2>q ∧ (case z of (d, e, f) ⇒ (∀x∈{q<..y2}. d * x2 + e * x + f ≠ 0))"
    by auto
  let ?y = "min y1 y2"
  have "?y > q ∧ (∀a∈set (z#neq). case a of (d, e, f) ⇒ ∀x∈{q<..?y}. d * x2 + e * x + f ≠ 0)"
    using y1_prop y2_prop
    by force
  then show ?case
    by blast
qed 


subsection "Some Casework"

lemma quadratic_shape1a:
  fixes a b c x y::"real"
  assumes agt: "a > 0"
  assumes xyroots: "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0"
  shows "⋀z. (z > x ∧ z < y ⟹ a*z^2 + b*z + c < 0)"
proof clarsimp 
  fix z
  assume zgt: "z > x"
  assume zlt: "z < y"
  have frac_gtz: "(1/(2*a)) > 0" using agt
    by simp 
  have xy_prop:"(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a))
    ∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = (-b - sqrt(b^2 - 4*a*c))/(2*a))" 
    using xyroots agt discriminant_iff unfolding discrim_def by auto   
  have "b^2 - 4*a*c ≥ 0" using xyroots discriminant_iff
    using assms(1) discrim_def by auto 
  then have pos_discrim: "b^2 - 4*a*c > 0" using xyroots discriminant_zero
    using ‹0 ≤ b2 - 4 * a * c› assms(1) discrim_def less_eq_real_def linorder_not_less
    by metis
  then have sqrt_gt: "sqrt(b^2 - 4*a*c) > 0"
    using real_sqrt_gt_0_iff by blast 
  then have "(- b - sqrt(b^2 - 4*a*c)) < (- b + sqrt(b^2 - 4*a*c))"
    by auto
  then have "(- b - sqrt(b^2 - 4*a*c))*(1/(2*a)) < (- b + sqrt(b^2 - 4*a*c))*(1/(2*a)) "
    using frac_gtz
    by (simp add: divide_strict_right_mono) 
  then have "(- b - sqrt(b^2 - 4*a*c))/(2*a) < (- b + sqrt(b^2 - 4*a*c))/(2*a)"
    by auto
  then have xandy: "x = (- b - sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (- b + sqrt(b^2 - 4*a*c))/(2*a)"
    using xy_prop xyroots by auto
  let ?mdpt = "-b/(2*a)"
  have xlt: "x < ?mdpt"
    using xandy sqrt_gt using frac_gtz divide_minus_left divide_strict_right_mono sqrt_gt
    by (smt (verit) agt)
  have ylt: "?mdpt < y"
    using xandy sqrt_gt frac_gtz
    by (smt (verit, del_insts) divide_strict_right_mono zero_less_divide_1_iff) 
  have mdpt_val: "a*?mdpt^2 + b*?mdpt + c < 0"
  proof - 
    have firsteq: "a*?mdpt^2 + b*?mdpt + c = (a*b^2)/(4*a^2) - (b^2)/(2*a) + c"
      by (simp add: power2_eq_square) 
    have h1: "(a*b^2)/(4*a^2) = (b^2)/(4*a)"
      by (simp add: power2_eq_square)
    have h2: "(b^2)/(2*a) = (2*b^2)/(4*a)"
      by linarith
    have h3: "c = (4*a*c)/(4*a)"
      using agt by auto 
    have "a*?mdpt^2 + b*?mdpt + c = (b^2)/(4*a) - (2*b^2)/(4*a) + (4*a*c)/(4*a) "
      using firsteq h1 h2 h3
      by linarith 
    then have "a*?mdpt^2 + b*?mdpt + c = (b^2 - 2*b^2 + 4*a*c)/(4*a)"
      by (simp add: diff_divide_distrib)
    then have eq2: "a*?mdpt^2 + b*?mdpt + c = (4*a*c - b^2)/(4*a)"
      by simp
    have h: "4*a*c - b^2 < 0" using pos_discrim by auto
    have "1/(4*a) > 0" using agt by auto
    then have "(4*a*c - b^2)*(1/(4*a)) < 0"
      using h
      using mult_less_0_iff by blast 
    then show ?thesis using eq2 by auto
  qed
  have nex: "¬ (∃k> x. k < y ∧ poly [:c, b, a:] k = 0)"
    using discriminant_iff agt
    by (metis (no_types, hide_lams) discrim_def order_less_irrefl quadratic_poly_eval xandy) 
  have nor2: "¬ (∃x>z. x < - b / (2 * a) ∧ poly [:c, b, a:] x = 0)"
    using nex xlt ylt zgt zlt by auto
  have nor: "¬ (∃x>- b / (2 * a). x < z ∧ poly [:c, b, a:] x = 0)"
    using nex xlt ylt zgt zlt discriminant_iff agt  by auto 
  then have mdpt_lt: "?mdpt < z ⟹ a*z^2 + b*z + c < 0 "
    using mdpt_val zgt zlt xlt ylt poly_IVT_pos[where p = "[:c, b, a:]", where a= "?mdpt", where b = "z"] 
      quadratic_poly_eval[of c b a]
    by (metis ‹¬ (∃k>x. k < y ∧ poly [:c, b, a:] k = 0)› linorder_neqE_linordered_idom) 
  have mdpt_gt: "?mdpt > z ⟹ a*z^2 + b*z + c < 0 "
    using zgt zlt mdpt_val xlt ylt nor2 poly_IVT_neg[where p = "[:c, b, a:]", where a = "z", where b = "?mdpt"] quadratic_poly_eval[of c b a]
    by (metis linorder_neqE_linordered_idom nex) 
  then show "a*z^2 + b*z + c < 0" 
    using mdpt_lt mdpt_gt mdpt_val by fastforce 
qed

lemma quadratic_shape1b:
  fixes a b c x y::"real"
  assumes agt: "a > 0"
  assumes xy_roots: "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0"
  shows "⋀z. (z > y ⟹ a*z^2 + b*z + c > 0)"
proof - 
  fix z
  assume z_gt :"z > y"
  have nogt: "¬(∃w. w > y ∧ a*w^2 + b*w + c = 0)" using xy_roots discriminant_iff
    by (metis agt less_eq_real_def linorder_not_less)
  have "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)"
    using agt pos_lc_dom_quad by auto
  then have "∃k > y.  a*k^2 + b*k + c > 0"
    by (metis add.commute agt less_add_same_cancel1 linorder_neqE_linordered_idom pos_add_strict) 
  then obtain k where k_prop: "k > y ∧ a*k^2 + b*k + c > 0" by auto
  have kgt: "k > z ⟹ a*z^2 + b*z + c > 0" 
  proof - 
    assume kgt: "k > z"
    then have zneq: "a*z^2 + b*z + c = 0 ⟹ False"
      using nogt  using z_gt by blast 
    have znlt: "a*z^2 + b*z + c < 0 ⟹ False"
      using kgt k_prop quadratic_poly_eval[of c b a] z_gt  nogt poly_IVT_pos[where a= "z", where b = "k", where p = "[:c, b, a:]"]
      by (metis less_eq_real_def less_le_trans)
    then show "a*z^2 + b*z + c > 0" using zneq znlt
      using linorder_neqE_linordered_idom by blast 
  qed
  have klt: "k < z ⟹ a*z^2 + b*z + c > 0" 
  proof - 
    assume klt: "k < z"
    then have zneq: "a*z^2 + b*z + c = 0 ⟹ False"
      using nogt using z_gt by blast 
    have znlt: "a*z^2 + b*z + c < 0 ⟹ False"
      using klt k_prop quadratic_poly_eval[of c b a] z_gt  nogt poly_IVT_neg[where a= "k", where b = "z", where p = "[:c, b, a:]"]
      by (metis add.commute add_less_cancel_left add_mono_thms_linordered_field(3) less_eq_real_def)
    then show "a*z^2 + b*z + c > 0" using zneq znlt
      using linorder_neqE_linordered_idom by blast 
  qed
  then show "a*z^2 + b*z + c > 0" using k_prop kgt klt
    by fastforce 
qed

lemma quadratic_shape2a:
  fixes a b c x y::"real"
  assumes "a < 0"
  assumes "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0"
  shows "⋀z. (z > x ∧ z < y ⟹ a*z^2 + b*z + c > 0)"
  using quadratic_shape1a[where a= "-a", where b = "-b", where c = "-c", where x = "x", where y = "y"]
  using assms(1) assms(2) by fastforce 

lemma quadratic_shape2b:
  fixes a b c x y::"real"
  assumes "a < 0"
  assumes "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0"
  shows "⋀z. (z > y ⟹ a*z^2 + b*z + c < 0)"
  using quadratic_shape1b[where a= "-a", where b = "-b", where c = "-c", where x = "x", where y = "y"]
  using assms(1) assms(2) by force 

lemma case_d1:
  fixes a b c r::"real"
  shows "b < 2 * a * r ⟹
    a * r^2 - b*r + c = 0 ⟹
    ∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c < 0"
proof - 
  assume b_lt: "b < 2*a*r"
  assume root: "a*r^2 - b*r + c = 0"
  then have "c = b*r - a*r^2" by auto
  have aeq: "a = 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c < 0"
  proof - 
    assume azer: "a = 0"
    then have bltz: "b < 0" using b_lt by auto
    then have "c = b*r" using azer root by auto
    then have eval: "∀x. a*x^2 + b*x + c = b*(x + r)" using azer
      by (simp add: distrib_left) 
    have "∀x > -r. b*(x + r) < 0" 
    proof clarsimp 
      fix x
      assume xgt: "- r < x"
      then have "x + r > 0"
        by linarith 
      then show "b * (x + r) < 0"
        using bltz using mult_less_0_iff by blast 
    qed
    then show ?thesis using eval
      using less_add_same_cancel1 zero_less_one
      by (metis greaterThanAtMost_iff)
  qed
  have aneq: "a ≠ 0 ⟹∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c < 0"
  proof - 
    assume aneq: "(a::real) ≠ 0"
    have "b^2 - 4*a*c < 0 ⟹ a * r2 + b * r + c ≠ 0" using root discriminant_negative[of a b c r] unfolding discrim_def 
      using aneq by auto
    then have " a * r2 + b * r + c ≠ 0 ⟹
    a * r2 - b * r + c = 0 ⟹
    b2 < 4 * a * c ⟹ False"
    proof -
      assume a1: "a * r2 - b * r + c = 0"
      assume a2: "b2 < 4 * a * c"
      have f3: "(0 ≤ - 1 * (4 * a * c) + (- 1 * b)2) = (4 * a * c + - 1 * (- 1 * b)2 ≤ 0)"
        by simp
      have f4: "(- 1 * b)2 + - 1 * (4 * a * c) = - 1 * (4 * a * c) + (- 1 * b)2"
        by auto
      have f5: "c + a * r2 + - 1 * b * r = a * r2 + c + - 1 * b * r"
        by auto
      have f6: "∀x0 x1 x2 x3. (x3::real) * x02 + x2 * x0 + x1 = x1 + x3 * x02 + x2 * x0"
        by simp
      have f7: "∀x1 x2 x3. (discrim x3 x2 x1 < 0) = (¬ 0 ≤ discrim x3 x2 x1)"
        by auto
      have f8: "∀r ra rb. discrim r ra rb = ra2 + - 1 * (4 * r * rb)"
        using discrim_def by auto
      have "¬ 4 * a * c + - 1 * (- 1 * b)2 ≤ 0"
        using a2 by simp
      then have "a * r2 + c + - 1 * b * r ≠ 0"
        using f8 f7 f6 f5 f4 f3 by (metis (no_types) aneq discriminant_negative)
      then show False
        using a1 by linarith
    qed 
    then have "¬(b^2 - 4*a*c < 0)" using root
      using ‹b2 - 4 * a * c < 0 ⟹ a * r2 + b * r + c ≠ 0› by auto
    then have discrim: "b2 ≥ 4 * a * c " by auto
    then have req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a) ∨ r = (b - sqrt(b^2 - 4*a*c))/(2*a)"
      using aneq root discriminant_iff[where a="a", where b ="-b", where c="c", where x="r"] unfolding discrim_def
      by auto
    then have "r = (b - sqrt(b^2 - 4*a*c))/(2*a) ⟹ b > 2*a*r"
    proof - 
      assume req: "r = (b - sqrt(b^2 - 4*a*c))/(2*a)"
      then have h1: "2*a*r = 2*a*((b - sqrt(b^2 - 4*a*c))/(2*a))" by auto
      then have h2: "2*a*((b - sqrt(b^2 - 4*a*c))/(2*a)) = b - sqrt(b^2 - 4*a*c)"
        using aneq by auto
      have h3: "sqrt(b^2 - 4*a*c) ≥ 0" using discrim  by auto
      then have "b - sqrt(b^2 - 4*a*c) < b"
        using b_lt h1 h2 by linarith
      then show ?thesis using req h2 by auto
    qed
    then have req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a)" using req b_lt by auto
    then have discrim2: "b^2 - 4 *a*c > 0" using aneq b_lt  by auto
    then have "∃x y. x ≠ y ∧ a * x2 + b * x + c = 0 ∧ a * y2 + b * y + c = 0"
      using aneq discriminant_pos_ex[of a b c] unfolding discrim_def
      by auto
    then obtain x y where xy_prop: "x < y ∧ a * x2 + b * x + c = 0 ∧ a * y2 + b * y + c = 0"
      by (meson linorder_neqE_linordered_idom)
    then have "(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a))
∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = (-b - sqrt(b^2 - 4*a*c))/(2*a))" 
      using aneq discriminant_iff unfolding discrim_def by auto   
    then have xy_prop2: "(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = -r)
    ∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = -r)" using req
      by (simp add: ‹x = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b2 - 4 * a * c)) / (2 * a)› minus_divide_left)
        (* When a < 0, -r is the bigger root *)
    have alt: "a < 0 ⟹ ∀k > -r. a * k^2 + b * k + c < 0"
    proof clarsimp 
      fix k
      assume alt: " a < 0"
      assume "- r < k"
      have alt2: " (1/(2*a)::real) < 0" using alt
        by simp 
      have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))"
        using discrim2 by auto
      then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) > (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)"
        using alt2
        using mult_less_cancel_left_neg by fastforce 
      then have rgtroot: "-r >  (-b + sqrt(b^2 - 4*a*c))/(2*a)"
        using req  ‹x = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b2 - 4 * a * c)) / (2 * a)› xy_prop2
        by auto 
      then have "(y = -r ∧ x = (-b + sqrt(b^2 - 4*a*c))/(2*a))"
        using xy_prop xy_prop2 by auto
      then show "a * k^2 + b * k + c < 0"
        using xy_prop ‹- r < k› alt quadratic_shape2b xy_prop 
        by blast 
    qed
      (* When a > 0, -r is the smaller root *)
    have agt: "a > 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c < 0"
    proof - 
      assume agt: "a> 0"
      have alt2: " (1/(2*a)::real) > 0" using agt
        by simp 
      have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))"
        using discrim2 by auto
      then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) < (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)"
        using alt2
      proof -
        have f1: "- b - sqrt (b2 - c * (4 * a)) < - b + sqrt (b2 - c * (4 * a))"
          by (metis ‹- b - sqrt (b2 - 4 * a * c) < - b + sqrt (b2 - 4 * a * c)› mult.commute)
        have "0 < a * 2"
          using ‹0 < 1 / (2 * a)› by auto
        then show ?thesis
          using f1 by (simp add: divide_strict_right_mono mult.commute)
      qed
      then have rlltroot: "-r <  (-b + sqrt(b^2 - 4*a*c))/(2*a)"
        using req ‹x = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b2 - 4 * a * c)) / (2 * a)› xy_prop2
        by auto
      then have "(x = -r ∧ y = (-b + sqrt(b^2 - 4*a*c))/(2*a))"
        using xy_prop xy_prop2 by auto
      have "∃k. x < k ∧ k < y" using xy_prop dense by auto
      then obtain k where k_prop: "x < k ∧ k < y" by auto
      then have "∀x∈{-r<..k}. a * x2 + b * x + c < 0"
        using agt quadratic_shape1a[where a= "a", where b = "b", where c= "c", where x = "x", where y = "y"]
        using ‹x = - r ∧ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a)› greaterThanAtMost_iff xy_prop by auto 
      then show "∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c < 0" 
        using k_prop using ‹x = - r ∧ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a)› by blast 
    qed
    show ?thesis
      using alt agt
      by (metis aneq greaterThanAtMost_iff less_add_same_cancel1 linorder_neqE_linordered_idom zero_less_one) 
  qed
  show "∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c < 0" using aeq aneq
    by blast 
qed

lemma case_d4:
  fixes a b c r::"real"
  shows "⋀y'. b ≠ 2 * a * r ⟹
          ¬ b < 2 * a * r ⟹
          a *r^2 - b * r + c = 0 ⟹
          -r < y' ⟹ ∃x∈{-r<..y'}. ¬ a * x2 + b * x + c < 0"
proof - 
  fix y'
  assume bneq: "b ≠ 2 * a * r"
  assume bnotless: "¬ b < 2 * a * r"
  assume root: "a *r^2 - b * r + c = 0"
  assume y_prop: "-r < y'"
  have b_gt: "b > 2*a*r" using bneq bnotless by auto
  have aeq: "a = 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c > 0"
  proof - 
    assume azer: "a = 0"
    then have bgt: "b > 0" using b_gt by auto
    then have "c = b*r" using azer root by auto
    then have eval: "∀x. a*x^2 + b*x + c = b*(x + r)" using azer
      by (simp add: distrib_left) 
    have "∀x > -r. b*(x + r) > 0" 
    proof clarsimp 
      fix x
      assume xgt: "- r < x"
      then have "x + r > 0"
        by linarith 
      then show "b * (x + r) > 0"
        using bgt by auto 
    qed
    then show ?thesis using eval 
      using less_add_same_cancel1 zero_less_one
      by (metis greaterThanAtMost_iff) 
  qed
  have aneq: "a ≠ 0 ⟹∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c > 0"
  proof - 
    assume aneq: "a≠0"  
    {
      assume a1: "a * r2 - b * r + c = 0"
      assume a2: "b2 < 4 * a * c"
      have f3: "(0 ≤ - 1 * (4 * a * c) + (- 1 * b)2) = (4 * a * c + - 1 * (- 1 * b)2 ≤ 0)"
        by simp
      have f4: "(- 1 * b)2 + - 1 * (4 * a * c) = - 1 * (4 * a * c) + (- 1 * b)2"
        by auto
      have f5: "c + a * r2 + - 1 * b * r = a * r2 + c + - 1 * b * r"
        by auto
      have f6: "∀x0 x1 x2 x3. (x3::real) * x02 + x2 * x0 + x1 = x1 + x3 * x02 + x2 * x0"
        by simp
      have f7: "∀x1 x2 x3. (discrim x3 x2 x1 < 0) = (¬ 0 ≤ discrim x3 x2 x1)"
        by auto
      have f8: "∀r ra rb. discrim r ra rb = ra2 + - 1 * (4 * r * rb)"
        using discrim_def by auto
      have "¬ 4 * a * c + - 1 * (- 1 * b)2 ≤ 0"
        using a2 by simp
      then have "a * r2 + c + - 1 * b * r ≠ 0"
        using f8 f7 f6 f5 f4 f3 by (metis (no_types) aneq discriminant_negative)
      then have False
        using a1 by linarith
    } note * = this
    have "b^2 - 4*a*c < 0 ⟹ a * r2 + b * r + c ≠ 0" using root discriminant_negative[of a b c r] unfolding discrim_def 
      using aneq by auto
    then have "¬(b^2 - 4*a*c < 0)" using root * by auto
    then have discrim: "b2 ≥ 4 * a * c " by auto
    then have req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a) ∨ r = (b - sqrt(b^2 - 4*a*c))/(2*a)"
      using aneq root discriminant_iff[where a="a", where b ="-b", where c="c", where x="r"] unfolding discrim_def
      by auto
    then have "r = (b + sqrt(b^2 - 4*a*c))/(2*a) ⟹ b < 2*a*r"
    proof - 
      assume req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a)"
      then have h1: "2*a*r = 2*a*((b + sqrt(b^2 - 4*a*c))/(2*a))" by auto
      then have h2: "2*a*((b + sqrt(b^2 - 4*a*c))/(2*a)) = b + sqrt(b^2 - 4*a*c)"
        using aneq by auto
      have h3: "sqrt(b^2 - 4*a*c) ≥ 0" using discrim  by auto
      then have "b + sqrt(b^2 - 4*a*c) > b"
        using b_gt h1 h2 by linarith
      then show ?thesis using req h2 by auto
    qed
    then have req: "r = (b - sqrt(b^2 - 4*a*c))/(2*a)" using req b_gt
      using aneq discrim by auto
    then have discrim2: "b^2 - 4 *a*c > 0" using aneq b_gt  by auto
    then have "∃x y. x ≠ y ∧ a * x2 + b * x + c = 0 ∧ a * y2 + b * y + c = 0"
      using aneq discriminant_pos_ex[of a b c] unfolding discrim_def
      by auto
    then obtain x y where xy_prop: "x < y ∧ a * x2 + b * x + c = 0 ∧ a * y2 + b * y + c = 0"
      by (meson linorder_neqE_linordered_idom)
    then have "(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a))
∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = (-b - sqrt(b^2 - 4*a*c))/(2*a))" 
      using aneq discriminant_iff unfolding discrim_def by auto   
    then have xy_prop2: "(x = (-b - sqrt(b^2 - 4*a*c))/(2*a) ∧ y = -r)
    ∨ (y = (-b - sqrt(b^2 - 4*a*c))/(2*a) ∧ x = -r)" using req divide_inverse minus_diff_eq mult.commute mult_minus_right
      by (smt (verit, ccfv_SIG) uminus_add_conv_diff)
        (* When a > 0, -r is the greater root *)
    have agt: "a > 0 ⟹ ∀k > -r. a * k^2 + b * k + c > 0"
    proof clarsimp 
      fix k
      assume agt: " a > 0"
      assume "- r < k"
      have agt2: " (1/(2*a)::real) > 0" using agt
        by simp 
      have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))"
        using discrim2 by auto
      then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) < (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)"
        using agt2 by (simp add: divide_strict_right_mono) 
      then have rgtroot: "-r >  (-b - sqrt(b^2 - 4*a*c))/(2*a)"
        using  req ‹x = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b2 - 4 * a * c)) / (2 * a)› xy_prop2
        by auto 
      then have "(x = (-b - sqrt(b^2 - 4*a*c))/(2*a)) ∧ y = -r"
        using xy_prop xy_prop2 
        by auto
      then show "a * k^2 + b * k + c > 0"
        using ‹- r < k› xy_prop agt quadratic_shape1b[where a= "a", where b ="b", where c="c", where x = "x", where y = "-r", where z = "k"]    
        by blast 
    qed
      (* When a < 0, -r is the smaller root *)
    have agt2: "a < 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c > 0"
    proof - 
      assume alt: "a<0"
      have alt2: " (1/(2*a)::real) < 0" using alt
        by simp 
      have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))"
        using discrim2 by auto
      then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) > (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)"
        using alt2  using mult_less_cancel_left_neg by fastforce 
      then have rlltroot: "-r < (-b - sqrt(b^2 - 4*a*c))/(2*a)"
        using req 
        using ‹x = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b2 - 4 * a * c)) / (2 * a)› 
          xy_prop2 
        by auto
      then have h: "(x = -r ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a))"
        using xy_prop xy_prop2 
        by auto
      have "∃k. x < k ∧ k < y" using xy_prop dense by auto
      then obtain k where k_prop: "x < k ∧ k < y" by auto
      then have "∀x∈{-r<..k}. a * x2 + b * x + c > 0"
        using alt quadratic_shape2a[where a= "a", where b = "b", where c= "c", where x = "x", where y = "y"]
          xy_prop  h greaterThanAtMost_iff  by auto 
      then show "∃y'>- r. ∀x∈{-r<..y'}. a * x2 + b * x + c > 0" 
        using k_prop using h by blast 
    qed
    show ?thesis
      using aneq agt agt2
      by (meson greaterThanAtMost_iff linorder_neqE_linordered_idom y_prop) 
  qed
  show "∃x∈{-r<..y'}. ¬ a * x2 + b * x + c < 0" using aneq aeq
    by (metis greaterThanAtMost_iff less_eq_real_def linorder_not_less y_prop)
qed

lemma one_root_a_lt0:
  fixes a b c r y'::"real"
  assumes alt: "a < 0"
  assumes beq: "b = 2 * a * r"
  assumes root: " a * r^2 - 2*a*r*r + c = 0"
  shows "∃y'>- r. ∀x∈{- r<..y'}. a * x2 + 2*a*r*x + c < 0"
proof - 
  have root_iff: "∀x. a * x2 + b * x + c = 0 ⟷ x = -r" using alt root discriminant_lemma[where r = "r"] beq 
    by auto
  have "a < 0 ⟶ (∃y. ∀x > y. a*x^2 + b*x + c < 0)" using neg_lc_dom_quad 
    by auto
  then obtain k where k_prop: "∀x > k. a*x^2 + b*x + c < 0" using alt by auto
  let ?mx = "max (k+1) (-r + 1)"
  have "a*?mx^2 + b*?mx + c < 0" using k_prop by auto
  then have "∃y > -r. a*y^2 + b*y + c < 0"
    by force
  then obtain z where z_prop: "z > -r ∧ a*z^2 + b*z + c < 0" by auto
  have poly_eval_prop: "∀(x::real). poly [:c, b, a :] x = a*x^2 + b*x + c" 
    using quadratic_poly_eval by auto
  then have nozer: "¬(∃x. (x > -r ∧ poly [:c, b, a :] x = 0))" using root_iff 
    by (simp add: add.commute) 
  have poly_z: "poly [:c, b, a:] z < 0" using z_prop poly_eval_prop by auto
  have "∀y > -r. a*y^2 + b*y + c < 0" 
  proof clarsimp 
    fix y
    assume ygt: "- r < y"
    have h1: "y = z ⟹ a * y2 + b * y + c < 0" using z_prop by auto
    have h2: "y < z ⟹ a * y2 + b * y + c < 0" proof -
      assume ylt: "y < z"
      have notz: "a*y^2 + b*y + c ≠ 0" using ygt nozer poly_eval_prop by auto
      have h1: "a *y^2 + b*y + c > 0 ⟹ poly [:c, b, a:] y > 0" using poly_eval_prop by auto
      have ivtprop: "poly [:c, b, a:] y > 0 ⟹ (∃x. y < x ∧ x < z ∧ poly [:c, b, a:] x = 0)" 
        using ylt poly_z poly_IVT_neg[where a = "y", where b = "z", where p = "[:c, b, a:]"]
        by auto
      then have "a*y^2 + b*y + c > 0 ⟹ False" using h1 ivtprop ygt nozer by auto
      then show "a*y^2 + b*y + c < 0" using notz
        using linorder_neqE_linordered_idom by blast 
    qed
    have h3: "y > z ⟹ a * y2 + b * y + c < 0" 
    proof -
      assume ygtz: "y > z"
      have notz: "a*y^2 + b*y + c ≠ 0" using ygt nozer poly_eval_prop by auto
      have h1: "a *y^2 + b*y + c > 0 ⟹ poly [:c, b, a:] y > 0" using poly_eval_prop by auto
      have ivtprop: "poly [:c, b, a:] y > 0 ⟹ (∃x. z < x ∧ x < y ∧ poly [:c, b, a:] x = 0)" 
        using ygtz poly_z using poly_IVT_pos by blast 
      then have "a*y^2 + b*y + c > 0 ⟹ False" using h1 ivtprop z_prop nozer by auto
      then show "a*y^2 + b*y + c < 0" using notz
        using linorder_neqE_linordered_idom by blast 
    qed
    show "a * y2 + b * y + c < 0" using h1 h2 h3
      using linorder_neqE_linordered_idom by blast
  qed
  then show ?thesis
    using ‹∃y>- r. a * y2 + b * y + c < 0› beq by auto 
qed


lemma one_root_a_lt0_var:
  fixes a b c r y'::"real"
  assumes alt: "a < 0"
  assumes beq: "b = 2 * a * r"
  assumes root: " a * r^2 - 2*a*r*r + c = 0"
  shows "∃y'>- r. ∀x∈{- r<..y'}. a * x2 + 2*a*r*x + c ≤ 0"
proof - 
  have h1: "∃y'>- r. ∀x∈{- r<..y'}. a * x2 + 2 * a * r * x + c < 0 ⟹
     ∃y'>-r. ∀x∈{- r<..y'}. a * x2 + 2 * a *r * x + c ≤ 0"
    using less_eq_real_def by blast
  then show ?thesis
    using one_root_a_lt0[of a b r] assms by auto
qed

subsection "More Continuity Properties"
lemma continuity_lem_gt0_expanded_var: 
  fixes r:: "real"
  fixes a b c:: "real"
  fixes k::"real"
  assumes kgt: "k > r"
  shows "a*r^2 + b*r + c > 0 ⟹
    ∃x∈{r<..k}. a*x^2 + b*x + c ≥ 0"
proof -
  assume a: "a*r^2 + b*r + c > 0  "
  have h: "∃x∈{r<..k}. a*x^2 + b*x + c > 0  ⟹ ∃x∈{r<..k}. a*x^2 + b*x + c ≥ 0"
    using less_eq_real_def by blast 
  have "∃x∈{r<..k}. a*x^2 + b*x + c > 0" using a continuity_lem_gt0_expanded[of r k a b c] assms by auto
  then show "∃x∈{r<..k}. a*x^2 + b*x + c ≥ 0"
    using h by auto
qed

lemma continuity_lem_lt0_expanded_var: 
  fixes r:: "real"
  fixes a b c:: "real"
  shows "a*r^2 + b*r + c < 0 ⟹
    ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c ≤ 0"
proof - 
  assume "a*r^2 + b*r + c < 0 "
  then have " ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c < 0"
    using continuity_lem_lt0_expanded by auto
  then show " ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c ≤ 0"
    using less_eq_real_def by auto
qed

lemma nonzcoeffs:
  fixes a b c r::"real"
  shows "a≠0 ∨ b≠0 ∨ c≠0 ⟹ ∃y'>r. ∀x∈{r<..y'}. a * x2 + b * x + c ≠ 0 "
proof - 
  assume "a≠0 ∨ b≠0 ∨ c≠0"
  then have fin: "finite {x. a*x^2 + b*x + c = 0}"
    by (metis pCons_eq_0_iff poly_roots_finite poly_roots_set_same) 
      (* then have fin2: "finite {x. a*x^2 + b*x + c = 0 ∧ x > r}"
    using finite_Collect_conjI by blast *)
  let ?s = "{x. a*x^2 + b*x + c = 0}"
  have imp: "(∃q ∈ ?s. q > r) ⟹ (∃q ∈ ?s. (q > r ∧ (∀x ∈ ?s. x > r ⟶ x ≥ q)))"
  proof - 
    assume asm: "(∃q ∈ ?s. q > r)"
    then have none: "{q. q ∈ ?s ∧ q > r} ≠ {}"
      by blast 
    have fin2: "finite {q. q ∈ ?s ∧ q > r}" using fin
      by simp
    have "∃k. k = Min  {q. q ∈ ?s ∧ q > r}" using fin2 none
      by blast
    then obtain k where k_prop: "k =  Min  {q. q ∈ ?s ∧ q > r}" by auto
    then have kp1: "k ∈ ?s ∧ k > r" 
      using Min_in fin2 none
      by blast 
    then  have kp2: "∀x ∈ ?s. x > r ⟶ x ≥ k" 
      using Min_le fin2  using k_prop by blast 
    show "(∃q ∈ ?s. (q > r ∧ (∀x ∈ ?s. x > r ⟶ x ≥ q)))" 
      using kp1 kp2 by blast
  qed
  have h2: "(∃q ∈ ?s. q > r) ⟹ ∃y'>r. ∀x∈{r<..y'}. a * x2 + b * x + c ≠ 0" 
  proof - 
    assume "(∃q ∈ ?s. q > r)"
    then obtain q where q_prop: "q ∈ ?s ∧ (q > r ∧ (∀x ∈ ?s. x > r ⟶ x ≥ q))"
      using imp by blast 
    then have "∃w. w > r ∧ w < q" using dense
      by blast
    then obtain w where w_prop: "w > r ∧ w < q" by auto
    then have "¬(∃x∈{r<..w}. x ∈ ?s)"
      using w_prop q_prop by auto
    then have "∀x∈{r<..w}. a * x2 + b * x + c ≠ 0"
      by blast
    then show "∃y'>r. ∀x∈{r<..y'}. a * x2 + b * x + c ≠ 0"
      using w_prop by blast
  qed
  have h1: "¬(∃q ∈ ?s. q > r) ⟹ ∃y'>r. ∀x∈{r<..y'}. a * x2 + b * x + c ≠ 0"
  proof - 
    assume "¬(∃q ∈ ?s. q > r)"
    then have "∀x∈{r<..(r+1)}. a * x2 + b * x + c ≠ 0"
      using greaterThanAtMost_iff by blast
    then show ?thesis
      using less_add_same_cancel1 less_numeral_extra(1) by blast 
  qed
  then show "∃y'>r. ∀x∈{r<..y'}. a * x2 + b * x + c ≠ 0"
    using h2 by blast
qed


(* Show if there are infinitely many values of x where a*x^2 + b*x + c is 0,
then the a*x^2 + b*x + c is the zero polynomial *)
lemma infzeros : 
  fixes y:: "real"
  assumes "∀x::real < (y::real). a * x2 + b * x + c = 0"
  shows "a = 0 ∧ b=0 ∧ c=0"
proof - 
  let ?A = "{(x::real). x < y}"
  have "∃ (n::nat) f. ?A = f ` {i. i < n} ∧ inj_on f {i. i < n} ⟹ False"
  proof clarsimp 
    fix n:: "nat" 
    fix f
    assume xlt: "{x. x < y} = f ` {i. i < n}"
    assume injh: "inj_on f {i. i < n}"
    have "?A ≠ {}"
      by (simp add: linordered_field_no_lb)
    then have ngtz: "n > 0" 
      using xlt injh using gr_implies_not_zero by auto 
    have cardisn: "card ?A = n" using xlt injh
      by (simp add: card_image) 
    have "∀k::nat. ((y - (k::nat) - 1) ∈ ?A)" 
      by auto
    then have subs: "{k. ∃(x::nat). k = y - x - 1 ∧ 0 ≤ x ∧ x ≤ n} ⊆ ?A"
      by auto
    have seteq: "(λx. y - real x - 1) ` {0..n} ={k. ∃(x::nat). k = y - x - 1 ∧ 0 ≤ x ∧ x ≤ n}"
      by auto
    have injf: "inj_on (λx. y - real x - 1) {0..n}"
      unfolding inj_on_def by auto
    have "card {k. ∃(x::nat). k = y - x - 1 ∧ 0 ≤ x ∧ x ≤ n} = n + 1"
      using  injf seteq card_atMost inj_on_iff_eq_card[where A = "{0..n}", where f = "λx. y - x - 1"] 
      by auto
    then have if_fin: "finite ?A ⟹ card ?A ≥ n + 1" 
      using subs card_mono
      by (metis (lifting) card_mono)
    then have if_inf: "infinite ?A ⟹ card ?A = 0"
      by (meson card.infinite)
    then show "False" using if_fin if_inf cardisn ngtz by auto
  qed
  then have nfin: "¬ finite {(x::real). x < y}"
    using finite_imp_nat_seg_image_inj_on by blast
  have "{(x::real). x < y} ⊆ {x. a*x^2 + b*x + c = 0}"
    using assms by auto
  then have nfin2: "¬ finite {x. a*x^2 + b*x + c = 0}"
    using nfin finite_subset by blast 
  {
    fix x
    assume "a * x2 + b * x + c = 0"
    then have f1: "a * (x * x) + x * b + c = 0"
      by (simp add: Groups.mult_ac(2) power2_eq_square)
    have f2: "∀r. c + (r + (c + - c)) = r + c"
      by simp
    have f3: "∀r ra rb. (rb::real) * ra + ra * r = (rb + r) * ra"
      by (metis Groups.mult_ac(2) Rings.ring_distribs(2))
    have "∀r. r + (c + - c) = r"
      by simp
    then have "c + x * (b + x * a) = 0"
      using f3 f2 f1 by (metis Groups.add_ac(3) Groups.mult_ac(1) Groups.mult_ac(2))
  }
  hence "{x. a*x^2 + b*x + c = 0} ⊆ {x. poly [:c, b, a:] x = 0}"
    by auto
  then have " ¬ finite {x. poly [:c, b, a:] x = 0}" 
    using nfin2 using finite_subset by blast 
  then have "[:c, b, a:] = 0" 
    using poly_roots_finite[where p = "[:c, b, a:]"]  by auto
  then show ?thesis
    by auto
qed



lemma have_inbetween_point_leq:
  fixes r::"real"
  assumes "(∀((d::real), (e::real), (f::real))∈set leq. ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0)"
  shows "(∃x. (∀(a, b, c)∈set leq. a * x2 + b * x + c ≤ 0))"
proof -
  have "(∀(d, e, f)∈set leq. ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ⟹ 
    (∃y'>r. (∀(d, e, f)∈set leq. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0))"
    using leq_qe_inf_helper assms by auto
  then have "(∃y'>r. (∀(d, e, f)∈set leq. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0))"
    using assms
    by blast 
  then obtain y where y_prop: "y > r ∧  (∀(d, e, f)∈set leq. ∀x∈{r<..y}. d * x2 + e * x + f ≤ 0)"
    by auto
  have "∃q. q >  r ∧q < y" using y_prop dense by auto
  then obtain q where q_prop: "q > r ∧ q < y" by auto
  then have "(∀(d, e, f)∈set leq. d*q^2 + e*q + f ≤ 0)"
    using y_prop by auto
  then show ?thesis
    by auto
qed


lemma have_inbetween_point_neq:
  fixes r::"real"
  assumes "(∀((d::real), (e::real), (f::real))∈set neq. ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0)"
  shows "(∃x. (∀(a, b, c)∈set neq. a * x2 + b * x + c ≠ 0))"
proof -
  have "(∀(d, e, f)∈set neq. ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0) ⟹ 
    (∃y'>r. (∀(d, e, f)∈set neq. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))"
    using neq_qe_inf_helper assms by auto
  then have "(∃y'>r. (∀(d, e, f)∈set neq. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))"
    using assms
    by blast 
  then obtain y where y_prop: "y > r ∧  (∀(d, e, f)∈set neq. ∀x∈{r<..y}. d * x2 + e * x + f ≠ 0)"
    by auto
  have "∃q. q >  r ∧q < y" using y_prop dense by auto
  then obtain q where q_prop: "q > r ∧ q < y" by auto
  then have "(∀(d, e, f)∈set neq. d*q^2 + e*q + f ≠ 0)"
    using y_prop by auto
  then show ?thesis
    by auto
qed

subsection "Setting up and Helper Lemmas"
subsubsection "The les\\_qe lemma"
lemma les_qe_forward : 
  shows "(((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0))))) ⟹ ((∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)))"
proof -
  assume big_asm: "(((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0)))))"
  then have big_or: "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨ 
               (∃(a', b', c')∈set les.
               a' = 0 ∧
               b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0)) 
        ∨
        (∃(a', b', c')∈set les.
               a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
               (∀(d, e, f)∈set les.
                   ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                      ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) 
      ∨
      (∃(a', b', c')∈set les.  a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
                (∀(d, e, f)∈set les.
                    ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                       ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                          d * x2 + e * x + f < 0)) " 
    by auto
  have h1_helper: "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  proof - 
    show "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))" 
    proof (induct les)
      case Nil
      then show ?case
        by auto
    next
      case (Cons q les) 
      have ind: " ∀a∈set (q # les). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0"
        using Cons.prems
        by auto
      then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0 "
        by simp      
      then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒  (∀y<y2. a * y2 + ba * y + c < 0)"
        by auto
      have "∀a∈set les. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0"
        using ind by simp
      then have " ∃y. ∀x<y. ∀a∈set les. case a of (a, ba, c) ⇒ a * x2 + ba * x + c < 0"
        using Cons.hyps by blast 
      then obtain y1 where y1_prop: "∀x<y1. ∀a∈set les. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0"
        by blast
      let ?y = "min y1 y2"
      have "∀x < ?y.  (∀a∈set (q #les). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0)"
        using y1_prop y2_prop 
        by fastforce 
      then show ?case
        by blast 
    qed
  qed
  then have h1: "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ⟹(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    by (smt (z3) infzeros less_eq_real_def not_numeral_le_zero)
      (* apply (auto)
    by (metis (lifting) infzeros zero_neq_numeral) *)
  have h2: " (∃(a', b', c')∈set les.
               a' = 0 ∧
               b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0))
    ⟹ (∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  proof -
    assume asm: "(∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧
         (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0))"
    then obtain a' b' c' where abc_prop: "(a', b', c') ∈set les ∧ a' = 0 ∧ b' ≠ 0 ∧
         (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0)"
      by auto
    then show "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
      using have_inbetween_point_les by auto
  qed
  have h3: " (∃(a', b', c')∈set les.
               a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
               (∀(d, e, f)∈set les.
                   ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                      ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) ⟹ ((∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)))"
  proof - 
    assume asm: "∃(a', b', c')∈set les.  a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
                ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                   ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                      d * x2 + e * x + f < 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set les ∧ a' ≠ 0 ∧ 4 * a' * c' ≤ b'2 ∧
       (∀(d, e, f)∈set les.
           ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
              ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)"
      by auto
    then show "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
      using have_inbetween_point_les by auto
  qed
  have h4: "(∃(a', b', c')∈set les.  a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
                (∀(d, e, f)∈set les.
                    ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                       ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                          d * x2 + e * x + f < 0)) ⟹ (∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  proof - 
    assume asm: "(∃(a', b', c')∈set les.  a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0)) "
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set les ∧ a' ≠ 0 ∧ 4 * a' * c' ≤ b'2 ∧
     (∀(d, e, f)∈set les.
         ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
            ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}. d * x2 + e * x + f < 0)"
      by auto
    then have "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
      using have_inbetween_point_les by auto
    then show ?thesis using asm by auto
  qed 
  show ?thesis using big_or h1 h2 h3 h4
    by blast 
qed

(*sample points, some starter proofs below in comments *)
lemma les_qe_backward : 
  shows "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟹
    ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0))))"

proof - 
  assume havex: "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  then obtain x where x_prop: "∀(a, b, c)∈set les. a * x2 + b * x + c < 0" by auto
  have h: "(¬ (∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧ ¬ (∃(a', b', c')∈set les.
           a' = 0 ∧
           b' ≠ 0 ∧
           (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0)) ∧
        ¬ (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                  ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) ∧
        ¬ (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}. d * x2 + e * x + f < 0))) ⟹ False"
  proof -
    assume big: "(¬ (∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧ ¬ (∃(a', b', c')∈set les.
           a' = 0 ∧
           b' ≠ 0 ∧
           (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0)) ∧
        ¬ (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                  ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) ∧
        ¬ (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}. d * x2 + e * x + f < 0)))"
    have notneginf: "¬ (∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0)" using big by auto
    have notlinroot: "¬ (∃(a', b', c')∈set les.
           a' = 0 ∧
           b' ≠ 0 ∧
           (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0))" 
      using big by auto
    have notquadroot1: " ¬ (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                  ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0))"
      using big by auto
    have notquadroot2:" ¬ (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}. d * x2 + e * x + f < 0))"
      using big by auto
    have nok: "¬ (∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))"
    proof - 
      have "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0)) ⟹ False"
      proof - 
        assume "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))"
        then obtain k a b c where k_prop: "(a, b, c) ∈ set les ∧  a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0)"
          by auto
        have azer:  "a = 0 ⟹ False"
        proof - 
          assume azer: "a = 0"
          then have "b = 0 ⟹ c = 0" using k_prop by auto
          then have bnonz: "b≠ 0"
            using azer x_prop k_prop 
            by auto 
          then have "k = -c/b" using k_prop azer
            by (metis (no_types, hide_lams) add.commute add.left_neutral add_uminus_conv_diff diff_le_0_iff_le divide_non_zero less_eq_real_def mult_zero_left neg_less_iff_less order_less_irrefl real_add_less_0_iff)
          then have " (∃(a', b', c')∈set les.
           a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0))"
            using k_prop azer bnonz by auto
          then show "False" using notlinroot
            by auto
        qed
        have anonz: "a ≠ 0 ⟹ False"
        proof - 
          assume anonz: "a ≠ 0 "
          let ?r1 = "(- b - sqrt (b^2 - 4 * a * c)) / (2 * a)"
          let ?r2 = "(- b + sqrt (b^2 - 4 * a * c)) / (2 * a)"
          have discr: "4 * a * c ≤ b^2" using anonz k_prop discriminant_negative[of a b c] 
            unfolding discrim_def 
            by fastforce 
          then have "k = ?r1 ∨ k = ?r2" using k_prop discriminant_nonneg[of a b c] unfolding discrim_def
            using anonz
            by auto 
          then have "(∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                  ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) ∨
           (∃(a', b', c')∈set les.
           a' ≠ 0 ∧
           4 * a' * c' ≤ b'2 ∧
           (∀(d, e, f)∈set les.
               ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}. d * x2 + e * x + f < 0))"
            using discr anonz notquadroot1 notquadroot2 k_prop 
            by auto
          then show "False" using  notquadroot1 notquadroot2
            by auto
        qed
        show "False"
          using azer anonz  by auto
      qed
      then show ?thesis by auto
    qed
    have finset: "finite (set les)"
      by blast
    have h1: "(∃(a, b, c)∈set les. a = 0 ∧ b = 0 ∧ c = 0)  ⟹ False"
      using x_prop by fastforce
    then have h2: "¬(∃(a, b, c)∈set les. a = 0 ∧ b = 0 ∧ c = 0) ⟹ False"
    proof - 
      assume nozer: "¬(∃(a, b, c)∈set les. a = 0 ∧ b = 0 ∧ c = 0)"
      then have same_set: "root_set (set les) = set (sorted_root_list_set (set les))"
        using root_set_finite finset set_sorted_list_of_set
        by (simp add: nozer root_set_finite sorted_root_list_set_def)
      have xnotin: "x ∉ root_set (set les)"
        unfolding root_set_def using x_prop by auto
      let ?srl = "sorted_root_list_set (set les)"
      have notinlist: "¬ List.member ?srl x"
        using xnotin same_set
        by (simp add: in_set_member)
      then have notmem: "∀n < (length ?srl). x ≠ nth_default 0 ?srl n"
        using nth_mem same_set xnotin nth_default_def
        by metis  
      show ?thesis 
      proof (induct ?srl)
        case Nil
        then have "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0)"
        proof clarsimp 
          fix a b c
          assume noroots: "[] = sorted_root_list_set (set les)"
          assume inset: "(a, b, c) ∈ set les"
          have "{} = root_set (set les)" 
            using noroots same_set 
            by auto 
          then have nozero: "¬(∃x. a*x^2  + b*x + c = 0)"
            using inset unfolding root_set_def by auto
          have "∀y<x. a * y2 + b * y + c < 0" 
          proof clarsimp 
            fix y
            assume "y < x"
            then have "sign_num (a*x^2 + b*x + c) = sign_num (a*y^2 + b*y + c)"
              using nozero  by (metis changes_sign_var) 
            then show "a * y2 + b * y + c < 0"
              unfolding sign_num_def using x_prop inset 
              by (smt split_conv) 
          qed
          then show "∃x. ∀y<x. a * y2 + b * y + c < 0"
            by auto
        qed
        then show ?case using notneginf by auto
      next
        case (Cons w xa) 
          (* Need to argue that x isn't greater than the largest element of ?srl *)
          (* that if srl has length ≥ 2, x isn't in between any of the roots of ?srl*)
          (* and that x isn't less than the lowest root in ?srl *)
        then have lengthsrl: "length ?srl > 0" by auto
        have neginf: "x < nth_default 0 ?srl 0 ⟹ False"
        proof -
          assume xlt: "x < nth_default 0 ?srl 0"
          have all: "(∀(a, b, c)∈set les. ∀y<x. a * y2 + b * y + c < 0)"
          proof clarsimp 
            fix a b c y
            assume inset: "(a, b, c) ∈ set les"
            assume "y < x"
            have xl: "a*x^2 + b*x + c < 0" using x_prop inset by auto
            have "¬(∃q. q < nth_default 0 ?srl 0  ∧ a*q^2 + b*q + c = 0)"
            proof - 
              have "(∃q. q < nth_default 0 ?srl 0  ∧ a*q^2 + b*q + c = 0) ⟹ False"
              proof - assume "∃q. q < nth_default 0 ?srl 0  ∧ a*q^2 + b*q + c = 0"
                then obtain q where q_prop: "q < nth_default 0 ?srl 0 ∧a*q^2 + b*q + c = 0" by auto
                then have " q ∈ root_set (set les)" unfolding root_set_def using inset by auto
                then have "List.member ?srl q" using same_set
                  by (simp add: in_set_member)
                then have "q ≥ nth_default 0 ?srl 0"
                  using sorted_sorted_list_of_set[where A = "root_set (set les)"]
                  unfolding sorted_root_list_set_def
                  by (metis ‹q ∈ root_set (set les)› in_set_conv_nth le_less_linear lengthsrl not_less0 nth_default_nth same_set sorted_nth_mono sorted_root_list_set_def)
                then show "False" using q_prop by auto
              qed
              then show ?thesis by auto
            qed
            then have "¬(∃q. q < x ∧ a*q^2 + b*q + c = 0)" using xlt by auto
            then show " a * y2 + b * y + c < 0" 
              using xl changes_sign_var[where a = "a", where b = "b", where c = "c", where x = "y", where y = "x"]
              unfolding sign_num_def using ‹y < x› less_eq_real_def zero_neq_numeral 
              by fastforce
          qed
          have "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0)"
          proof clarsimp 
            fix a b c
            assume "(a, b, c)∈set les"
            then show "∃x. ∀y<x. a * y2 + b * y + c < 0" 
              using all by blast 
          qed
          then show "False" using notneginf by auto
        qed
        have "x > nth_default 0 ?srl (length ?srl - 1) ⟹ (∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))"
        proof - 
          assume xgt: "x > nth_default 0 ?srl (length ?srl - 1)"
          let ?lg = "nth_default 0 ?srl (length ?srl - 1)"
          have "List.member ?srl ?lg"
            by (metis diff_less in_set_member lengthsrl nth_default_def nth_mem zero_less_one)
          then have "?lg ∈ root_set (set les) "
            using same_set in_set_member[of ?lg ?srl]  by auto
          then have exabc: "∃(a, b, c)∈set les. a*?lg^2 + b*?lg + c = 0"
            unfolding root_set_def by auto
          have "(∀(d, e, f)∈set les. ∀q∈{?lg<..x}. d * q^2 + e * q + f < 0)"
          proof clarsimp 
            fix d e f q 
            assume inset: "(d, e, f) ∈ set les"
            assume qgt: "(nth_default 0) (sorted_root_list_set (set les)) (length (sorted_root_list_set (set les)) - Suc 0) < q"
            assume qlt: "q ≤ x"
            have nor: "¬(∃r. d * r^2 + e * r + f = 0 ∧ r > ?lg)"
            proof - 
              have "(∃r. d * r^2 + e * r + f = 0 ∧ r > ?lg) ⟹ False "
              proof - 
                assume "∃r. d * r^2 + e * r + f = 0 ∧ r > ?lg"
                then obtain r where r_prop: "d*r^2 + e*r + f = 0 ∧ r > ?lg" by auto
                then have "r ∈ root_set (set les)" using inset unfolding root_set_def by auto
                then have "List.member ?srl r"
                  using same_set in_set_member
                  by (simp add: in_set_member) 
                then have " r ≤ ?lg" using sorted_sorted_list_of_set nth_default_def
                  by (metis One_nat_def Suc_pred ‹r ∈ root_set (set les)› in_set_conv_nth lengthsrl lessI less_Suc_eq_le same_set sorted_nth_mono sorted_root_list_set_def)
                then show "False" using r_prop by auto
              qed
              then show ?thesis by auto
            qed
            then have xltz_helper: "¬(∃r. r ≥ q ∧ d * r^2 + e * r + f = 0)"
              using qgt by auto
            then have xltz: "d*x^2 + e*x + f < 0" using inset x_prop by auto
            show "d * q2 + e * q + f < 0"
              using qlt qgt nor changes_sign_var[of d _ e f _] xltz xltz_helper unfolding sign_num_def
              apply (auto) 
              by smt
          qed
          then have " (∀(d, e, f)∈set les. ∃y'>?lg. ∀x∈{?lg<..y'}. d * x2 + e * x + f < 0)"
            using xgt by auto
          then have "(∃(a, b, c)∈set les. a*?lg^2 + b*?lg + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>?lg. ∀x∈{?lg<..y'}. d * x2 + e * x + f < 0))"
            using exabc by auto
          then show "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))"
            by auto
        qed
        then have posinf: "x > nth_default 0 ?srl (length ?srl - 1) ⟹ False" 
          using nok by auto
        have "(∃n. (n+1) < (length ?srl) ∧ x > (nth_default 0 ?srl) n ∧ x < (nth_default 0 ?srl (n + 1))) ⟹ (∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))"
        proof - 
          assume "∃n. (n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1)"
          then obtain n where n_prop: "(n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1)" by auto
          let ?elt = "nth_default 0 ?srl n"
          let ?elt2 = "nth_default 0 ?srl (n + 1)"
          have "List.member ?srl ?elt"
            using n_prop nth_default_def
            by (metis add_lessD1 in_set_member nth_mem) 
          then have "?elt ∈ root_set (set les) "
            using same_set in_set_member[of ?elt ?srl]  by auto
          then have exabc: "∃(a, b, c)∈set les. a*?elt^2 + b*?elt + c = 0"
            unfolding root_set_def by auto
          then obtain a b c where "(a, b, c)∈set les ∧ a*?elt^2 + b*?elt + c = 0"
            by auto
          have xltel2: "x < ?elt2" using n_prop by auto
          have xgtel: "x > ?elt " using n_prop by auto
          have "(∀(d, e, f)∈set les. ∀q∈{?elt<..x}. d * q^2 + e * q + f < 0)"
          proof clarsimp 
            fix d e f q 
            assume inset: "(d, e, f) ∈ set les"
            assume qgt: "nth_default 0 (sorted_root_list_set (set les)) n < q"
            assume qlt: "q ≤ x"

            have nor: "¬(∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧r < ?elt2)"
            proof - 
              have "(∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧ r < ?elt2) ⟹ False "
              proof - 
                assume "∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt  ∧ r < ?elt2"
                then obtain r where r_prop: "d*r^2 + e*r + f = 0 ∧ r > ?elt  ∧ r < ?elt2" by auto
                then have "r ∈ root_set (set les)" using inset unfolding root_set_def by auto
                then have "List.member ?srl r"
                  using same_set in_set_member
                  by (simp add: in_set_member) 
                then have "∃i < (length ?srl). r = nth_default 0 ?srl i"
                  by (metis ‹r ∈ root_set (set les)› in_set_conv_nth same_set nth_default_def)
                then obtain i where i_prop: "i < (length ?srl) ∧ r = nth_default 0 ?srl i"
                  by auto
                have "r > ?elt" using r_prop by auto
                then  have igt: " i > n" using i_prop sorted_sorted_list_of_set
                  by (smt add_lessD1 leI n_prop nth_default_def sorted_nth_mono sorted_root_list_set_def)
                have "r < ?elt2" using r_prop by auto
                then have ilt: " i < n + 1" using i_prop sorted_sorted_list_of_set
                  by (smt leI n_prop nth_default_def sorted_nth_mono sorted_root_list_set_def) 
                then show "False"  using igt ilt
                  by auto
              qed
              then show ?thesis by auto
            qed
            then have nor: "¬(∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧r ≤ x)"
              using xltel2 xgtel by auto
            then have xltz: "d*x^2 + e*x + f < 0" using inset x_prop by auto
            show "d * q2 + e * q + f < 0"
              using qlt qgt nor changes_sign_var[of d _ e f _] xltz unfolding sign_num_def
              by smt 
          qed
          then have " (∀(d, e, f)∈set les. ∃y'>?elt. ∀x∈{?elt<..y'}. d * x2 + e * x + f < 0)"
            using xgtel xltel2 by auto
          then have "(∃(a, b, c)∈set les. a*?elt^2 + b*?elt + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>?elt. ∀x∈{?elt<..y'}. d * x2 + e * x + f < 0))"
            using exabc by auto
          then show "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧
                (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))"
            by auto
        qed
        then have inbetw: "(∃n. (n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1)) ⟹ False"
          using nok by auto
        have lenzer: "length xa = 0 ⟹ False" 
        proof - 
          assume "length xa = 0"
          have xis: "x > w ∨ x < w"
            using notmem Cons.hyps
            by (smt list.set_intros(1) same_set xnotin) 
          have xgt: "x > w ⟹ False"
          proof - 
            assume xgt: "x > w"
            show "False" using posinf Cons.hyps
              by (metis One_nat_def Suc_eq_plus1 ‹length xa = 0› cancel_comm_monoid_add_class.diff_cancel list.size(4) nth_default_Cons_0 xgt)
          qed
          have xlt: "x < w ⟹ False"
          proof - 
            assume xlt: "x < w"
            show "False" using neginf Cons.hyps
              by (metis nth_default_Cons_0 xlt) 
          qed
          show "False" using xis xgt xlt by auto
        qed
        have lengt: "length xa > 0 ⟹ False"
        proof - 
          assume "length xa > 0"
          have "x ≥ nth_default 0 ?srl 0" using neginf
            by fastforce
          then have xgtf: "x > nth_default 0 ?srl 0" using notmem
            using Cons.hyps(2) by fastforce
          have "x ≤ nth_default 0 ?srl (length ?srl - 1)" using posinf by fastforce
          then have "(∃n. (n+1) < (length ?srl) ∧ x ≥ nth_default 0 ?srl n ∧ x ≤ nth_default 0 ?srl (n + 1))"
            using lengthsrl xgtf notmem sorted_list_prop[where l = ?srl, where x = "x"]
            by (metis add_lessD1 diff_less nth_default_nth sorted_root_list_set_def sorted_sorted_list_of_set zero_less_one)
          then obtain n where n_prop: "(n+1) < (length ?srl) ∧ x ≥ nth_default 0 ?srl n ∧ x ≤ nth_default 0 ?srl (n + 1)" by auto
          then have "x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n+1)"
            using notmem
            by (metis Suc_eq_plus1 Suc_lessD less_eq_real_def)
          then have "(∃n. (n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1))"
            using n_prop
            by blast  
          then show "False" using inbetw by auto
        qed
        then show ?case using lenzer lengt by auto
      qed 
    qed
    show "False"
      using h1 h2 by auto
  qed
  then have equiv_false: "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨ 
               (∃(a', b', c')∈set les.
               a' = 0 ∧
               b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0)) 
        ∨
        (∃(a', b', c')∈set les.
               a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
               (∀(d, e, f)∈set les.
                   ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                      ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) 
      ∨
      (∃(a', b', c')∈set les.  a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
                (∀(d, e, f)∈set les.
                    ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                       ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                          d * x2 + e * x + f < 0))) ⟹ False"
    by linarith
  have "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0)))) ⟹ False"
  proof - 
    assume "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0))))"
    then have "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨ 
               (∃(a', b', c')∈set les.
               a' = 0 ∧
               b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0)) 
        ∨
        (∃(a', b', c')∈set les.
               a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
               (∀(d, e, f)∈set les.
                   ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                      ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x2 + e * x + f < 0)) 
      ∨
      (∃(a', b', c')∈set les.  a' ≠ 0 ∧
               4 * a' * c' ≤ b'2 ∧
                (∀(d, e, f)∈set les.
                    ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                       ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                          d * x2 + e * x + f < 0)))"
      by auto
    then show ?thesis
      using equiv_false by auto
  qed
  then show ?thesis
    by blast 
qed

lemma les_qe : 
  shows "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) =
    ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0))))"
proof -
  have first: "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟶
    ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0))))"
    using les_qe_backward by auto
  have second: "((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0)))) ⟶ (∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) "
    using les_qe_forward by auto
  have "(∃x. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟷
  ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∨
     (∃(a', b', c')∈set les.
         a' = 0 ∧
         b' ≠ 0 ∧
         (∀(d, e, f)∈set les.
             ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x2 + e * x + f < 0) ∨
         a' ≠ 0 ∧
         4 * a' * c' ≤ b'2 ∧
         ((∀(d, e, f)∈set les.
              ∃y'>(sqrt (b'2 - 4 * a' * c') - b') / (2 * a').
                 ∀x∈{(sqrt (b'2 - 4 * a' * c') - b') / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∨
          (∀(d, e, f)∈set les.
              ∃y'>(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' - sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0))))"
    using first second
    by meson 
  then show ?thesis
    by blast
qed


subsubsection "equiv\\_lemma"
lemma equiv_lemma: 
  assumes big_asm: "(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ∨
  (∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
          
      (∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ∨
     ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  shows "((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))" 
proof - 
  let ?t = " ((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  have h1: "(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ⟹ ?t"
    by auto
  have h2: "(∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ⟹ ?t" 
    by auto
  have h3: "(∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ⟹ ?t" 
    by auto
  show ?thesis
    using big_asm h1 h2 h3
    by presburger 
qed

subsubsection "The eq\\_qe lemma"
lemma eq_qe_forwards: 
  shows "(∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))  ⟹
    ((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
proof - 
  let ?big_or = "(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ∨
  (∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
          
      (∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ∨
     ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  assume asm: "(∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) " 
  then obtain x where x_prop: "(∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)" by auto
  have "¬ (∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ∧
  ¬ (∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∧
          ¬ (∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ∧
     ¬ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟹ False" 
  proof - 
    assume big_conj: "¬ (∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ∧
  ¬ (∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∧
          ¬ (∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ∧
     ¬ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    have not_lin: "¬(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0))"
      using big_conj by auto
    have not_quad1: "¬(∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)))"
      using big_conj by auto
    have not_quad2: "¬(∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))"
      using big_conj by auto
    have not_zer: "¬((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
      using big_conj by auto
    then have not_zer1: "¬(∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∨
     ¬ (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)" by auto
    have "(∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)" using asm 
      by auto 
    then have "¬(∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0)" using not_zer1 by auto
    then have "∃ (d, e, f)∈set eq. d ≠ 0 ∨ e ≠ 0 ∨ f ≠ 0 "
      by auto
    then obtain d e f where def_prop: "(d, e, f) ∈ set eq ∧ (d ≠ 0 ∨ e ≠ 0 ∨ f ≠ 0)" by auto
    then have eval_at_x: "d*x^2 + e*x + f = 0" using x_prop by auto
    have dnonz: "d ≠ 0 ⟹ False"
    proof - 
      assume dneq: "d ≠ 0"
      then have discr: "-(e^2) + 4 *d *f ≤ 0" using  discriminant_negative[of d e f x] eval_at_x unfolding discrim_def
        by linarith
      let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 *d *f)) / (2 * d)"
      let ?r2 = "(- e + 1 * sqrt (e^2 - 4 *d *f)) / (2 * d)"
      have xis: "x = ?r1 ∨ x = ?r2"
        using dneq discr discriminant_nonneg[of d e f x] eval_at_x unfolding discrim_def
        by auto
      have xr1: "x = ?r1 ⟹ False"
        using not_quad2 x_prop discr def_prop dneq by auto
      have xr2: "x = ?r2 ⟹ False"
        using not_quad1 x_prop discr def_prop dneq by auto
      show "False" using xr1 xr2 xis by auto
    qed
    then have dz: "d = 0" by auto
    have enonz: "e ≠ 0 ⟹ False" 
    proof - 
      assume enonz: "e≠ 0"
      then have "x = -f/e" using dz eval_at_x
        by (metis add.commute minus_add_cancel mult.commute mult_zero_class.mult_zero_left nonzero_eq_divide_eq) 
      then show "False"
        using not_lin x_prop enonz dz def_prop by auto
    qed
    then have ez: "e = 0" by auto
    have fnonz: "f ≠ 0 ⟹ False" using ez dz eval_at_x by auto
    show "False"
      using def_prop dnonz enonz fnonz by auto
  qed
  then have h: "¬(?big_or) ⟹ False"
    by auto
  then show ?thesis using equiv_lemma
    by presburger
qed

lemma eq_qe_backwards: "((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟹ 
    (∃x. ((∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)))
    "
proof - 
  assume "((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  then have bigor: "(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ∨
  (∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
          
      (∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ∨
     ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    by auto
  have h1: "(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)) ⟹
    (∃(x::real). (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))" 
  proof - 
    assume "(∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0))"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set eq ∧
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0)" by auto
    let ?x = "(-c' /b')::real"
    have "(∀(d, e, f)∈set eq. d * ?x2 + e * ?x + f = 0) ∧
         (∀(d, e, f)∈set les. d * ?x^2 + e * ?x + f < 0)" using abc_prop by auto
    then  show ?thesis using abc_prop by blast 
  qed
  have h2: " (∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ⟹ (∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  proof - 
    assume "(∃(a', b', c')∈set eq.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)))"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set eq ∧ a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))" by auto
    let ?x = "((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')::real)"
    have anonz: "a' ≠ 0" using abc_prop by auto
    then have "∃(q::real). q = ?x" by auto
    then obtain q where q_prop: "q = ?x" by auto
    have "(∀(d, e, f)∈set eq. d * (?x)2 + e * (?x) + f = 0) ∧
          (∀(d, e, f)∈set les. d * (?x)2 + e * (?x) + f < 0)"
      using abc_prop by auto
    then have "(∀(d, e, f)∈set eq. d * q2 + e * q + f = 0) ∧
          (∀(d, e, f)∈set les. d * q2 + e * q + f < 0)" using q_prop by auto
    then show ?thesis by auto
  qed
  have h3: "(∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)) ⟹ (∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))" 
  proof - 
    assume "(∃(a', b', c')∈set eq. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))"
    then obtain a' b' c' where abc_prop: "a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (a', b', c')∈set eq ∧ (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0)" by auto
    let ?x = "(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')"
    have anonz: "a' ≠ 0" using abc_prop by auto
    then have "∃(q::real). q = ?x" by auto
    then obtain q where q_prop: "q = ?x" by auto
    have "(∀(d, e, f)∈set eq. d * (?x)2 + e * (?x) + f = 0) ∧
          (∀(d, e, f)∈set les. d * (?x)2 + e * (?x) + f < 0)"
      using abc_prop by auto
    then have "(∀(d, e, f)∈set eq. d * q2 + e * q + f = 0) ∧
          (∀(d, e, f)∈set les. d * q2 + e * q + f < 0)" using q_prop by auto
    then show ?thesis by auto
  qed
  have h4: "((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟹ (∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
  proof - 
    assume asm: "((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    then have allzer: "(∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0)" by auto
    have "(∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)" using asm by auto
    then obtain x where x_prop: " ∀(a, b, c)∈set les. a * x2 + b * x + c < 0" by auto
    then have "∀(d, e, f)∈set eq. d*x^2 + e*x + f = 0"
      using allzer by auto
    then show ?thesis using x_prop by auto
  qed
  show ?thesis
    using bigor h1 h2 h3 h4
    by blast 
qed


lemma eq_qe : "(∃x. ((∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))) =
    ((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
proof - 
  have h1: "(∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟶
    ((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    using eq_qe_forwards by auto
  have h2: "((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟶ (∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    using eq_qe_backwards by auto
  have h3: "(∃x. (∀(a, b, c)∈set eq. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set les. a * x2 + b * x + c < 0)) ⟷
    ((∃(a', b', c')∈set eq.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set les. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∨
          (∀(d, e, f)∈set eq.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set les.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0))) ∨
     (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧
     (∃x. ∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
    using h1 h2
    by smt 
  then  show ?thesis
    by (auto) 
qed

subsubsection "The qe\\_forwards lemma"
lemma qe_forwards_helper_gen:
  fixes r:: "real"
  assumes f8: "¬(∃((a'::real), (b'::real), (c'::real))∈set c. 
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         ((∀(d, e, f)∈set a. d * r2 + e * r + f = 0) ∧
         (∀(d, e, f)∈set b. d * r^2 + e * r + f < 0) ∧
         (∀(d, e, f)∈set c. d * r^2 + e * r + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * r^2 + e * r + f ≠ 0)))"
  assumes alleqset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)"
  assumes f5: "¬(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  assumes f6: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  assumes f7: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  assumes f10: "¬(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  assumes f11: "¬(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  assumes f12: "¬(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  shows "¬(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))" 
proof - 
  have "(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0)) ⟹ False"
  proof - 
    assume "(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0)"
      by auto
    have h1: "(∀(d, e, f)∈set a. d * r^2 + e * r + f = 0)" 
      using alleqset
      by blast
    have c_prop: "(∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0)" 
      using abc_prop by auto 
    have h2: "(∀(d, e, f)∈set c. d *r^2 + e * r + f ≤ 0)" 
    proof - 
      have c1: "∃ (d, e, f) ∈ set c.  d * (r)2 + e * (r) + f > 0 ⟹ False"
      proof - 
        assume "∃ (d, e, f) ∈ set c.  d * (r)2 + e * (r) + f > 0"
        then obtain d e f where def_prop: "(d, e, f) ∈ set c ∧ d * (r)2 + e * r + f > 0"
          by auto
        have "∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0"
          using def_prop c_prop   by auto
        then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0)" by auto
        have "∃x∈{r<..y'}. d*x^2 + e*x + f > 0"
          using def_prop continuity_lem_gt0_expanded[of "r" y' d e f]
          using y_prop by linarith 
        then show "False" using  y_prop
          by auto  
      qed
      then show ?thesis
        by fastforce 
    qed
    have b_prop: "(∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0)" 
      using abc_prop by auto
    have h3: "(∀(d, e, f)∈set b. d * r2 + e * r + f < 0)" 
    proof - 
      have c1: "∃ (d, e, f) ∈ set b.  d * r2 + e * r + f > 0 ⟹ False"
      proof - 
        assume "∃ (d, e, f) ∈ set b.  d * r2 + e * r + f > 0"
        then obtain d e f where def_prop: "(d, e, f) ∈ set b ∧ d * r2 + e * r + f > 0"
          by auto
        then have "∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0"
          using b_prop by auto
        then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d * x2 + e * x + f < 0)" by auto
        then have "∃k. k > r ∧ k < y' ∧ d * k^2 + e * k + f < 0" using dense
          by (meson dense greaterThanAtMost_iff less_eq_real_def) 
        then obtain k where k_prop: "k > r ∧ k < y' ∧ d * k^2 + e * k + f < 0" 
          by auto
        then have "¬(∃x>r. x < y' ∧ d * x2 + e * x + f = 0)"
          using y_prop by force 
        then show "False" using k_prop def_prop y_prop poly_IVT_neg[of "r" "k" "[:f, e, d:]"] poly_IVT_pos[of "-c'/b'" "k" "[:f, e, d:]"]
          by (smt quadratic_poly_eval)
      qed
      have c2: "∃ (d, e, f) ∈ set b.  d * r2 + e * r + f = 0 ⟹ False" 
      proof - 
        assume "∃ (d, e, f) ∈ set b.  d * r2 + e * r + f = 0"
        then obtain d' e f where def_prop: "(d', e, f) ∈ set b ∧ d' * r2 + e * r + f = 0"
          by auto
        then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = r)" 
        proof - 
          assume asm: "(d' = 0 ∧ e ≠ 0)" 
          then have " e * r + f = 0" using def_prop 
            by auto
          then show "-f/e = r" using asm
            by (metis (no_types) add.commute diff_0 divide_minus_left minus_add_cancel nonzero_mult_div_cancel_left uminus_add_conv_diff) 
        qed
        let ?r = "-f/e"
        have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set b ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≠ 0)))"
          using same def_prop abc_prop by auto
        then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))" 
          by auto
        then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f5 
          by auto 
        have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - 
          assume "(d' = 0 ∧ e = 0 ∧ f = 0)"
          then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto
          have "∃y'>r. ∀x∈{r<..y'}. d' * x2 + e * x + f < 0"
            using b_prop def_prop  by auto
          then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d' * x2 + e * x + f < 0)" by auto
          then have "∃k. k > r ∧ k < y' ∧ d' * k^2 + e * k + f < 0" using dense
            by (meson dense greaterThanAtMost_iff less_eq_real_def) 
          then show "False" using allzer
            by auto
        qed
        have f3: "d' ≠ 0 ⟹ False" 
        proof - 
          assume dnonz: "d' ≠ 0"
          have discr: " - e2 + 4 * d' * f ≤ 0"
            using def_prop discriminant_negative[of d' e f] unfolding discrim_def
            using def_prop by fastforce
          then have two_cases: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')
          ∨ r = (- e + 1 * sqrt (e2 - 4 * d' * f)) / (2 * d')"
            using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def
            by fastforce
          have some_props: "((d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0)"
            using dnonz def_prop discr by auto
          let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          have cf1: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f7 by auto
          qed
          have cf2: "r = (- e +  1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "r = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f6 by auto
          qed
          then show "False" using two_cases cf1 cf2 by auto
        qed
          (* discriminant_nonnegative *)
        have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" 
          using def_prop by auto
        then show "False" using f1 f2 f3 by auto
      qed
      show ?thesis using c1 c2
        by fastforce
    qed
    have d_prop: "(∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0)" 
      using abc_prop by auto
    have h4: "(∀(d, e, f)∈set d. d * r2 + e * r + f ≠ 0)"
    proof - 
      have "(∃(d, e, f)∈set d. d * r2 + e * r + f = 0) ⟹ False"
      proof - 
        assume "∃ (d, e, f) ∈ set d.  d * r2 + e * r + f = 0"
        then obtain d' e f where def_prop: "(d', e, f) ∈ set d ∧ d' * r2 + e * r + f = 0"
          by auto
        then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = r)" 
        proof - 
          assume asm: "(d' = 0 ∧ e ≠ 0)" 
          then have " e * r + f = 0" using def_prop 
            by auto
          then show "-f/e = r" using asm
            by (metis (no_types) add.commute diff_0 divide_minus_left minus_add_cancel nonzero_mult_div_cancel_left uminus_add_conv_diff) 
        qed
        let ?r = "-f/e"
        have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set d ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≠ 0)))"
          using same def_prop abc_prop by auto
        then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x2 + e * x + f ≠ 0))" 
          by auto
        then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f10 
          by auto 
        have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - 
          assume "(d' = 0 ∧ e = 0 ∧ f = 0)"
          then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto
          have "∃y'> r. ∀x∈{ r<..y'}. d' * x2 + e * x + f ≠ 0"
            using d_prop def_prop 
            by auto
          then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d' * x2 + e * x + f ≠ 0)" by auto
          then have "∃k. k > r ∧ k < y' ∧ d' * k^2 + e * k + f ≠ 0" using dense
            by (meson dense greaterThanAtMost_iff less_eq_real_def) 
          then show "False" using allzer
            by auto
        qed
        have f3: "d' ≠ 0 ⟹ False" 
        proof - 
          assume dnonz: "d' ≠ 0"
          have discr: " - e2 + 4 * d' * f ≤ 0"
            using def_prop discriminant_negative[of d' e f] unfolding discrim_def
            by fastforce
          then have two_cases: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')
          ∨ r = (- e + 1 * sqrt (e2 - 4 * d' * f)) / (2 * d')"
            using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def
            by fastforce
          have some_props: "((d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0)"
            using dnonz def_prop discr by auto
          let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          have cf1: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f12 by auto
          qed
          have cf2: "r = (- e +  1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "r = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f11 by auto
          qed
          then show "False" using two_cases cf1 cf2 by auto
        qed
          (* discriminant_nonnegative *)
        have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" 
          using def_prop by auto
        then show "False" using f1 f2 f3 by auto
      qed
      then show ?thesis by auto
    qed
    have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a. d * r2 + e * r + f = 0) ∧
         (∀(d, e, f)∈set b. d * r2 + e * r + f < 0) ∧
         (∀(d, e, f)∈set c. d * r2 + e * r + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * r2 + e * r + f ≠ 0))"
      using h1 h2 h3 h4 abc_prop by auto
    then show "False" using f8 by auto
  qed
  then show ?thesis by auto
qed



lemma qe_forwards_helper_lin:
  assumes alleqset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)"
  assumes f5: "¬(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  assumes f6: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  assumes f7: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  assumes f8: "¬(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
  assumes f10: "¬(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  assumes f11: "¬(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  assumes f12: "¬(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  shows "¬(∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))" 
proof - 
  have "(∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)) ⟹ False"
  proof - 
    assume "(∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)"
      by auto
    then have bnonz: "b'≠0" by auto
    have h1: "(∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0)" 
      using bnonz alleqset
      by blast
    have c_prop: "(∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0)" 
      using abc_prop by auto 
    have h2: "(∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0)" 
    proof - 
      have c1: "∃ (d, e, f) ∈ set c.  d * (- c' / b')2 + e * (- c' / b') + f > 0 ⟹ False"
      proof - 
        assume "∃ (d, e, f) ∈ set c.  d * (- c' / b')2 + e * (- c' / b') + f > 0"
        then obtain d e f where def_prop: "(d, e, f) ∈ set c ∧ d * (- c' / b')2 + e * (- c' / b') + f > 0"
          by auto
        have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0"
          using def_prop c_prop   by auto
        then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0)" by auto
        have "∃x∈{(-c'/b')<..y'}. d*x^2 + e*x + f > 0"
          using def_prop continuity_lem_gt0_expanded[of "(-c'/b')" y' d e f]
          using y_prop by linarith 
        then show "False" using  y_prop
          by auto  
      qed
      then show ?thesis
        by fastforce 
    qed
    have b_prop: "(∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0)" 
      using abc_prop by auto
    have h3: "(∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0)" 
    proof - 
      have c1: "∃ (d, e, f) ∈ set b.  d * (- c' / b')2 + e * (- c' / b') + f > 0 ⟹ False"
      proof - 
        assume "∃ (d, e, f) ∈ set b.  d * (- c' / b')2 + e * (- c' / b') + f > 0"
        then obtain d e f where def_prop: "(d, e, f) ∈ set b ∧ d * (- c' / b')2 + e * (- c' / b') + f > 0"
          by auto
        then have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0"
          using b_prop by auto
        then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0)" by auto
        then have "∃k. k > -c'/b' ∧ k < y' ∧ d * k^2 + e * k + f < 0" using dense
          by (meson dense greaterThanAtMost_iff less_eq_real_def) 
        then obtain k where k_prop: "k > -c'/b' ∧ k < y' ∧ d * k^2 + e * k + f < 0" 
          by auto
        then have "¬(∃x>(-c'/b'). x < y' ∧ d * x2 + e * x + f = 0)"
          using y_prop by force 
        then show "False" using k_prop def_prop y_prop poly_IVT_neg[of "-c'/b'" "k" "[:f, e, d:]"] poly_IVT_pos[of "-c'/b'" "k" "[:f, e, d:]"]
          by (smt quadratic_poly_eval)
      qed
      have c2: "∃ (d, e, f) ∈ set b.  d * (- c' / b')2 + e * (- c' / b') + f = 0 ⟹ False" 
      proof - 
        assume "∃ (d, e, f) ∈ set b.  d * (- c' / b')2 + e * (- c' / b') + f = 0"
        then obtain d' e f where def_prop: "(d', e, f) ∈ set b ∧ d' * (- c' / b')2 + e * (- c' / b') + f = 0"
          by auto
        then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = -c'/b')" 
        proof - 
          assume asm: "(d' = 0 ∧ e ≠ 0)" 
          then have " e * (- c' / b') + f = 0" using def_prop 
            by auto
          then show "-f/e = -c'/b'" using asm 
            by auto
        qed
        let ?r = "-f/e"
        have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set b ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≠ 0)))"
          using same def_prop abc_prop by auto
        then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))" 
          by auto
        then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f5 
          by auto 
        have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - 
          assume "(d' = 0 ∧ e = 0 ∧ f = 0)"
          then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto
          have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d' * x2 + e * x + f < 0"
            using b_prop def_prop  by auto
          then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d' * x2 + e * x + f < 0)" by auto
          then have "∃k. k > -c'/b' ∧ k < y' ∧ d' * k^2 + e * k + f < 0" using dense
            by (meson dense greaterThanAtMost_iff less_eq_real_def) 
          then show "False" using allzer
            by auto
        qed
        have f3: "d' ≠ 0 ⟹ False" 
        proof - 
          assume dnonz: "d' ≠ 0"
          have discr: " - e2 + 4 * d' * f ≤ 0"
            using def_prop discriminant_negative[of d' e f] unfolding discrim_def
            by fastforce
          then have two_cases: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')
          ∨ (- c' / b') = (- e + 1 * sqrt (e2 - 4 * d' * f)) / (2 * d')"
            using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def
            by fastforce
          have some_props: "((d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0)"
            using dnonz def_prop discr by auto
          let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          have cf1: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f7 by auto
          qed
          have cf2: "(- c' / b') = (- e +  1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "(- c' / b') = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f6 by auto
          qed
          then show "False" using two_cases cf1 cf2 by auto
        qed
          (* discriminant_nonnegative *)
        have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" 
          using def_prop by auto
        then show "False" using f1 f2 f3 by auto
      qed
      show ?thesis using c1 c2
        by fastforce
    qed
    have d_prop: "(∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)" 
      using abc_prop by auto
    have h4: "(∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)"
    proof - 
      have "(∃(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f = 0) ⟹ False"
        (* begin *)
      proof - 
        assume "∃ (d, e, f) ∈ set d.  d * (- c' / b')2 + e * (- c' / b') + f = 0"
        then obtain d' e f where def_prop: "(d', e, f) ∈ set d ∧ d' * (- c' / b')2 + e * (- c' / b') + f = 0"
          by auto
        then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = -c'/b')" 
        proof - 
          assume asm: "(d' = 0 ∧ e ≠ 0)" 
          then have " e * (- c' / b') + f = 0" using def_prop 
            by auto
          then show "-f/e = -c'/b'" using asm 
            by auto
        qed
        let ?r = "-f/e"
        have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set d ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≠ 0)))"
          using same def_prop abc_prop by auto
        then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))" 
          by auto
        then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f10 
          by auto 
        have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - 
          assume "(d' = 0 ∧ e = 0 ∧ f = 0)"
          then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto
          have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d' * x2 + e * x + f ≠ 0"
            using d_prop def_prop  by auto
          then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d' * x2 + e * x + f ≠ 0)" by auto
          then have "∃k. k > -c'/b' ∧ k < y' ∧ d' * k^2 + e * k + f ≠ 0" using dense
            by (meson dense greaterThanAtMost_iff less_eq_real_def) 
          then show "False" using allzer
            by auto
        qed
        have f3: "d' ≠ 0 ⟹ False" 
        proof - 
          assume dnonz: "d' ≠ 0"
          have discr: " - e2 + 4 * d' * f ≤ 0"
            using def_prop discriminant_negative[of d' e f] unfolding discrim_def
            by fastforce
          then have two_cases: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')
          ∨ (- c' / b') = (- e + 1 * sqrt (e2 - 4 * d' * f)) / (2 * d')"
            using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def
            by fastforce
          have some_props: "((d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0)"
            using dnonz def_prop discr by auto
          let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
          have cf1: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f12 by auto
          qed
          have cf2: "(- c' / b') = (- e +  1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" 
          proof - 
            assume "(- c' / b') = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')"
            then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e2 + 4 * d' * f ≤ 0 ∧ 
    ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f = 0) ∧
    (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f < 0) ∧
    (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≤ 0) ∧
    (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x2 + e * x + f ≠ 0))"
              using abc_prop some_props by auto
            then show "False" using f11 by auto
          qed
          then show "False" using two_cases cf1 cf2 by auto
        qed
          (* discriminant_nonnegative *)
        have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" 
          using def_prop by auto
        then show "False" using f1 f2 f3 by auto
      qed
      then show ?thesis by auto
    qed
    have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
      using h1 h2 h3 h4 bnonz abc_prop by auto
    then show "False" using f8 by auto
  qed
  then show ?thesis by auto
qed



lemma qe_forwards_helper:
  assumes alleqset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)"
  assumes f1: "¬((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0))"
  assumes f5: "¬(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  assumes f6: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  assumes f7: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  assumes f8: "¬(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
  assumes f13: "¬(∃(a', b', c')∈set c.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  assumes f9: "¬(∃(a', b', c')∈set c.  a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))"
  assumes f10: "¬(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  assumes f11: "¬(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  assumes f12: "¬(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  shows "¬(∃x. (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))" 
proof - 
  have nor: "∀r. ¬(∃(a', b', c')∈set c. 
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         ((∀(d, e, f)∈set a. d * r2 + e * r + f = 0) ∧
         (∀(d, e, f)∈set b. d * r^2 + e * r + f < 0) ∧
         (∀(d, e, f)∈set c. d * r^2 + e * r + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * r^2 + e * r + f ≠ 0)))" 
  proof clarsimp
    fix r t u v
    assume inset: "(t, u, v) ∈ set c"
    assume eo: "t = 0 ⟶ u ≠ 0 "
    assume zero_eq: "t*r^2 + u*r + v = 0"
    assume ah: "∀x∈set a. case x of (d, e, f) ⇒ d * r2 + e * r + f = 0"
    assume bh: "∀x∈set b. case x of (d, e, f) ⇒ d * r2 + e * r + f < 0" 
    assume ch: "∀x∈set c. case x of (d, e, f) ⇒ d * r2 + e * r + f ≤ 0"
    assume dh: "∀x∈set d. case x of (d, e, f) ⇒ d * r2 + e * r + f ≠ 0"
    have two_cases: "t ≠ 0 ∨ (t = 0 ∧ u ≠ 0)" using eo by auto
    have c1: "t ≠ 0 ⟹ False" 
    proof - 
      assume tnonz:  "t ≠ 0"
      then have discr_prop: "- u2 + 4 * t * v ≤ 0 "
        using discriminant_negative[of t u v] zero_eq unfolding discrim_def
        by force 
      then have ris: "r =  ((-u + - 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ∨
       r = ((-u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) "
        using tnonz discriminant_nonneg[of t u v] zero_eq unfolding discrim_def by auto 
      let ?r1 = "((-u + - 1 * sqrt (u^2 - 4 * t * v)) / (2 * t))"
      let ?r2 = "((-u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t))" 
      have ris1: "r = ?r1 ⟹ False"
      proof - 
        assume "r = ?r1"
        then have "(∃(a', b', c')∈set c.  a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))" 
          using inset ah bh ch dh discr_prop tnonz by auto
        then show ?thesis 
          using f9 by auto
      qed
      have ris2: "r = ?r2 ⟹ False" 
      proof - 
        assume "r = ?r2"
        then have "(∃(a', b', c')∈set c.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))" 
          using inset ah bh ch dh discr_prop tnonz by auto
        then show ?thesis 
          using f13 by auto
      qed
      show "False" using ris ris1 ris2 by auto 
    qed
    have c2: "(t = 0 ∧ u ≠ 0) ⟹ False" 
    proof - 
      assume asm: "t = 0 ∧ u ≠ 0"
      then have "r = -v/u" using zero_eq add.right_neutral  nonzero_mult_div_cancel_left     
        by (metis add.commute divide_divide_eq_right divide_eq_0_iff neg_eq_iff_add_eq_0)
      then have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
        using asm inset ah bh ch dh by auto
      then show "False" using f8
        by auto
    qed
    then show "False" using two_cases c1 c2 by auto
  qed
  have keyh: "⋀r. ¬(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))"
  proof - 
    fix r
    have h8: "¬(∃(a', b', c')∈set c. 
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         ((∀(d, e, f)∈set a. d * r2 + e * r + f = 0) ∧
         (∀(d, e, f)∈set b. d * r^2 + e * r + f < 0) ∧
         (∀(d, e, f)∈set c. d * r^2 + e * r + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * r^2 + e * r + f ≠ 0)))" 
      using nor by auto
    show "¬(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>r. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))"
      using qe_forwards_helper_gen[of c r a b d]
        alleqset  f5 f6 f7 h8 f10 f11 f12 
      by auto
  qed
  have f8a: "¬(∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
    using qe_forwards_helper_lin[of a b c d] alleqset f5 f6 f7 f8 f10 f11 f12
    by blast 
  have f13a: "¬ (∃(a', b', c')∈set c. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  proof - 
    have "(∃(a', b', c')∈set c. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) ⟹ False" 
    proof - 
      assume "(∃(a', b', c')∈set c. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
      then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))" by auto
      let ?r = "(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')"
      have somek: "∃k. k = ?r" by auto
      then obtain k where k_prop: "k = ?r" by auto
      have "(a'≠ 0 ∨ b'≠ 0) ∧ (a'*?r^2 + b'*?r + c' = 0)" 
        using abc_prop discriminant_nonneg[of a' b' c'] 
        unfolding discrim_def apply (auto)
        by (metis (mono_tags, lifting) times_divide_eq_right) 
      then have "(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*?r^2 + b'*?r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≠ 0))"
        using abc_prop by auto
      then have "(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≠ 0))"
        using k_prop by auto
      then have "∃k. (∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≠ 0))"
        by auto 
      then show "False" using keyh by auto
    qed
    then
    show ?thesis
      by auto
  qed
  have f9a: "¬ (∃(a', b', c')∈set c. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))" 

  proof - 
    have "(∃(a', b', c')∈set c. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)) ⟹ False" 
    proof - 
      assume "(∃(a', b', c')∈set c. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
      then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)" by auto
      let ?r = "(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')"
      have somek: "∃k. k = ?r" by auto
      then obtain k where k_prop: "k = ?r" by auto
      have "(a'≠ 0 ∨ b'≠ 0) ∧ (a'*?r^2 + b'*?r + c' = 0)" 
        using abc_prop discriminant_nonneg[of a' b' c'] 
        unfolding discrim_def apply (auto)
        by (metis (mono_tags, lifting) times_divide_eq_right) 
      then have "(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*?r^2 + b'*?r + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>?r. ∀x∈{?r<..y'}. d * x2 + e * x + f ≠ 0))"
        using abc_prop by auto
      then have "(∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≠ 0))"
        using k_prop by auto
      then have "∃k. (∃(a', b', c')∈set c.
         ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≠ 0))"
        by auto 
      then show "False" using keyh by auto
    qed
    then
    show ?thesis
      by auto
  qed
    (* We need to show that the point is in one of these ranges *)
  have "(∃x. (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)) ⟹ False"
  proof - 
    assume "(∃x. (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
    then obtain x where x_prop: "(∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" by auto
    (* Need this sorted_nonzero_root_list_set in case some of the tuples from set c are (0, 0, 0) *)
    let ?srl = "sorted_nonzero_root_list_set (((set b) ∪ (set c))∪ (set d))"
    have alleqsetvar: "∀(t, u, v) ∈ set a. t = 0 ∧ u = 0 ∧ v = 0"
    proof clarsimp
      fix t u v
      assume "(t, u, v) ∈ set a"
      then have "∀x. t*x^2 + u*x + v = 0" 
        using alleqset by auto 
      then have "∀x∈{0<..1}. t * x2 + u * x + v = 0" 
        by auto
      then show "t = 0 ∧ u = 0 ∧ v = 0" 
        using continuity_lem_eq0[of 0 1 t u v] 
        by auto  
    qed
      (* Should violate f1 *)
    have lenzero: "length ?srl = 0 ⟹ False"
    proof - 
      assume lenzero: "length ?srl = 0"
      have ina: "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)"
        using alleqsetvar by auto 
      have inb: "(∀(a, b, c)∈set b. ∀y. a * y2 + b * y + c < 0)"
      proof clarsimp 
        fix t u v y
        assume insetb: "(t, u, v) ∈ set b"
        then have "t * x2 + u * x + v < 0" using x_prop by auto
        then have tuv_prop: "t ≠ 0 ∨ u ≠ 0 ∨ v ≠ 0"
          by auto 
        then have tuzer: "(t = 0 ∧ u = 0) ⟹ ¬(∃q. t * q2 + u * q + v = 0)"
          by simp
        then have tunonz: "(t ≠ 0 ∨ u ≠ 0) ⟹ ¬(∃q. t * q2 + u * q + v = 0)"
        proof - 
          assume tuv_asm: "t ≠ 0 ∨ u ≠ 0"
          have "∃q. t * q2 + u * q + v = 0 ⟹ False"
          proof - 
            assume "∃ q. t * q2 + u * q + v = 0"
            then obtain q where "t * q2 + u * q + v = 0" by auto
            then have qin: "q ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
              using insetb tuv_asm tuv_prop by auto
            have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
              unfolding sorted_nonzero_root_list_set_def
              using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
              by auto
            then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def
              by auto 
            then have "List.member ?srl q"     
              using in_set_member[of q ?srl]
              by auto
            then show "False"
              using lenzero
              by (simp add: member_rec(2)) 
          qed
          then show ?thesis by auto
        qed
        have nozer: "¬(∃q. t * q2 + u * q + v = 0)" 
          using  tuzer tunonz
          by blast 
        have samesn: "sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
        proof - 
          have "x < y ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
            using changes_sign_var[of t x u v y] nozer by auto
          have "y < x ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
            using changes_sign_var[of t y u v x] nozer
          proof -
            assume "y < x"
            then show ?thesis
              using ‹∄q. t * q2 + u * q + v = 0› ‹sign_num (t * y2 + u * y + v) ≠ sign_num (t * x2 + u * x + v) ∧ y < x ⟹ ∃q. t * q2 + u * q + v = 0 ∧ y ≤ q ∧ q ≤ x› by presburger
          qed
          show ?thesis
            using changes_sign_var using ‹x < y ⟹ sign_num (t * x2 + u * x + v) = sign_num (t * y2 + u * y + v)› ‹y < x ⟹ sign_num (t * x2 + u * x + v) = sign_num (t * y2 + u * y + v)› 
            by fastforce 
        qed
          (* changes_sign_var *)
        have "sign_num (t*x^2 + u*x + v) = -1" using insetb unfolding sign_num_def using x_prop 
          by auto 
        then have "sign_num (t*y^2 + u*y + v) = -1" using samesn by auto
        then show "t * y2 + u * y + v < 0" unfolding sign_num_def
          by smt
      qed
      have inc: "(∀(a, b, c)∈set c. ∀y. a * y2 + b * y + c ≤ 0)"
      proof clarsimp 
        fix t u v y
        assume insetc: "(t, u, v) ∈ set c"
        then have "t * x2 + u * x + v ≤ 0" using x_prop by auto
        then have tuzer: "t = 0 ∧ u = 0 ⟹ t*y^2 + u*y + v ≤ 0 " 
        proof - 
          assume tandu: "t = 0 ∧ u = 0"
          then have "v ≤ 0" using insetc x_prop 
            by auto
          then show "t*y^2 + u*y + v ≤ 0" using tandu 
            by auto
        qed
        have tunonz: "t ≠ 0 ∨ u ≠ 0 ⟹ t*y^2 + u*y + v ≤ 0"
        proof - 
          assume tuv_asm: "t ≠ 0 ∨ u ≠ 0"
          have insetcvar: "t*x^2 + u*x + v < 0" 
          proof - 
            have "t*x^2 + u*x + v = 0 ⟹ False" 
            proof -
              assume zer: "t*x^2 + u*x + v = 0"
              then have xin: "x ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
                using insetc tuv_asm by auto
              have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
                unfolding sorted_nonzero_root_list_set_def
                using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                  nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
                by auto
              then have "x ∈ set ?srl" using xin unfolding nonzero_root_set_def
                by auto 
              then have "List.member ?srl x"     
                using in_set_member[of x ?srl]
                by auto
              then show "False" using lenzero
                by (simp add: member_rec(2)) 
            qed
            then show ?thesis
              using ‹t * x2 + u * x + v ≤ 0› by fastforce 
          qed
          then have tunonz: "¬(∃q. t * q2 + u * q + v = 0)"
          proof - 
            have "∃q. t * q2 + u * q + v = 0 ⟹ False"
            proof - 
              assume "∃ q. t * q2 + u * q + v = 0"
              then obtain q where "t * q2 + u * q + v = 0" by auto
              then have qin: "q ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
                using insetc tuv_asm by auto
              have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
                unfolding sorted_nonzero_root_list_set_def
                using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                  nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
                by auto
              then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def
                by auto 
              then have "List.member ?srl q"     
                using in_set_member[of q ?srl]
                by auto
              then show "False"
                using lenzero
                by (simp add: member_rec(2)) 
            qed
            then show ?thesis by auto
          qed
          have nozer: "¬(∃q. t * q2 + u * q + v = 0)" 
            using  tuzer tunonz
            by blast 
          have samesn: "sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
          proof - 
            have "x < y ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
              using changes_sign_var[of t x u v y] nozer by auto
            have "y < x ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
              using changes_sign_var[of t y u v x] nozer
            proof -
              assume "y < x"
              then show ?thesis
                using ‹∄q. t * q2 + u * q + v = 0› ‹sign_num (t * y2 + u * y + v) ≠ sign_num (t * x2 + u * x + v) ∧ y < x ⟹ ∃q. t * q2 + u * q + v = 0 ∧ y ≤ q ∧ q ≤ x› by presburger
            qed
            show ?thesis
              using changes_sign_var using ‹x < y ⟹ sign_num (t * x2 + u * x + v) = sign_num (t * y2 + u * y + v)› ‹y < x ⟹ sign_num (t * x2 + u * x + v) = sign_num (t * y2 + u * y + v)› 
              by fastforce 
          qed
            (* changes_sign_var *)
          have "sign_num (t*x^2 + u*x + v) = -1" using insetcvar unfolding sign_num_def using x_prop 
            by auto 
          then have "sign_num (t*y^2 + u*y + v) = -1" using samesn by auto
          then show "t * y2 + u * y + v ≤ 0" unfolding sign_num_def
            by smt
        qed
        then show "t * y2 + u * y + v ≤ 0" 
          using tuzer tunonz
          by blast 
      qed
      have ind: "(∀(a, b, c)∈set d. ∀y. a * y2 + b * y + c ≠ 0)"
      proof clarsimp 
        fix t u v y
        assume insetd: "(t, u, v) ∈ set d"
        assume falseasm: "t * y2 + u * y + v = 0"
        then have snz: "sign_num (t*y^2 + u*y + v) = 0"
          unfolding sign_num_def by auto
        have "t * x2 + u * x + v ≠ 0" using insetd x_prop by auto
        then have tuv_prop: "t ≠ 0 ∨ u ≠ 0 ∨ v ≠ 0"
          by auto 
        then have tuzer: "(t = 0 ∧ u = 0) ⟹ ¬(∃q. t * q2 + u * q + v = 0)"
          by simp
        then have tunonz: "(t ≠ 0 ∨ u ≠ 0) ⟹ ¬(∃q. t * q2 + u * q + v = 0)"
        proof - 
          assume tuv_asm: "t ≠ 0 ∨ u ≠ 0"
          have "∃q. t * q2 + u * q + v = 0 ⟹ False"
          proof - 
            assume "∃ q. t * q2 + u * q + v = 0"
            then obtain q where "t * q2 + u * q + v = 0" by auto
            then have qin: "q ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
              using insetd tuv_asm tuv_prop by auto
            have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
              unfolding sorted_nonzero_root_list_set_def
              using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
              by auto
            then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def
              by auto 
            then have "List.member ?srl q"     
              using in_set_member[of q ?srl]
              by auto
            then show "False"
              using lenzero
              by (simp add: member_rec(2)) 
          qed
          then show ?thesis by auto
        qed
        have nozer: "¬(∃q. t * q2 + u * q + v = 0)" 
          using  tuzer tunonz
          by blast 
        have samesn: "sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
        proof - 
          have "x < y ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
            using changes_sign_var[of t x u v y] nozer by auto
          have "y < x ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)"
            using changes_sign_var[of t y u v x] nozer
          proof -
            assume "y < x"
            then show ?thesis
              using ‹∄q. t * q2 + u * q + v = 0› ‹sign_num (t * y2 + u * y + v) ≠ sign_num (t * x2 + u * x + v) ∧ y < x ⟹ ∃q. t * q2 + u * q + v = 0 ∧ y ≤ q ∧ q ≤ x› by presburger
          qed
          show ?thesis
            using changes_sign_var using ‹x < y ⟹ sign_num (t * x2 + u * x + v) = sign_num (t * y2 + u * y + v)› ‹y < x ⟹ sign_num (t * x2 + u * x + v) = sign_num (t * y2 + u * y + v)› 
            by fastforce 
        qed
          (* changes_sign_var *)
        have "sign_num (t*x^2 + u*x + v) = -1 ∨ sign_num (t*x^2 + u*x + v) = 1 " 
          using insetd unfolding sign_num_def using x_prop 
          by auto 
        then have "sign_num (t*y^2 + u*y + v) = -1 ∨ sign_num (t*y^2 + u*y + v) = 1" using samesn by auto
        then show "False"  using snz by auto 
      qed
        (* Show all the polynomials never change sign *)
      have "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∀y. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∀y. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∀y. a * y2 + b * y + c ≠ 0))"
        using ina inb inc ind by auto
      then  show "False" 
        using f1
        by auto 
    qed
    have cases_mem: "(List.member ?srl x) ⟹ False"
    proof - 
      assume "(List.member ?srl x)"
      then have "x ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
        using set_sorted_list_of_set nonzero_root_set_finite in_set_member
        by (metis List.finite_set finite_Un nonzero_root_set_def sorted_nonzero_root_list_set_def)
      then have "∃ (a, b, c) ∈ (((set b) ∪ (set c))∪ (set d)) . (a ≠ 0 ∨ b ≠ 0) ∧ a*x^2 + b*x + c = 0"
        by blast
      then obtain t u v where def_prop: "(t, u, v) ∈ (((set b) ∪ (set c))∪ (set d)) ∧ (t ≠ 0 ∨ u ≠ 0) ∧ t*x^2 + u*x + v = 0"
        by auto
      have notinb: "(t, u, v) ∉ (set b)"
      proof - 
        have "(t, u, v) ∈ (set b ) ⟹ False"
        proof - 
          assume "(t, u, v) ∈ (set b)"
          then have "t*x^2 + u*x + v < 0" using x_prop
            by blast
          then show "False" using def_prop
            by simp 
        qed
        then  show ?thesis by auto
      qed
      have notind: "(t, u, v) ∉ (set d)"
      proof - 
        have "(t, u, v) ∈ (set d) ⟹ False"
        proof - 
          assume "(t, u, v) ∈ (set d)"
          then have "t*x^2 + u*x + v ≠ 0" using x_prop 
            by blast
          then show "False" using def_prop 
            by simp
        qed
        then show ?thesis by auto
      qed
      then have inset: "(t, u, v) ∈ (set c)"
        using def_prop notinb notind
        by blast 
      have case1: "t ≠ 0 ⟹ False"
      proof - 
        assume tnonz: "t ≠ 0" 
        then have r1or2:"x = (- u + - 1 * sqrt (u2 - 4 * t * v)) / (2 * t) ∨
            x = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t) "
          using def_prop discriminant_negative[of t u v] discriminant_nonneg[of t u v]
          apply (auto) 
          using notinb apply (force)
           apply (simp add: discrim_def discriminant_iff)
          using notind by force 
        have discrh: "-1*u^2 + 4 * t * v ≤ 0" 
          using tnonz discriminant_negative[of t u v] unfolding discrim_def
          using def_prop by force 
        have r1: "x = (- u + - 1 * sqrt (u2 - 4 * t * v)) / (2 * t) ⟹ False"
        proof - 
          assume xis: "x = (- u + - 1 * sqrt (u2 - 4 * t * v)) / (2 * t)"
          have " t ≠ 0 ∧
         - 1*u^2 + 4 * t * v ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
               d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * x2 + e * x + f ≠ 0)"
            using tnonz alleqset discrh x_prop
            by auto
          then have "(∃(a', b', c')∈set c.  a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))" 
            using xis inset 
            by auto
          then show "False"
            using f9 by auto
        qed
        have r2: "x = (- u + 1 * sqrt (u2 - 4 * t * v)) / (2 * t) ⟹ False" 
        proof - 
          assume xis: "x = (- u + 1 * sqrt (u2 - 4 * t * v)) / (2 * t)"
          have " t ≠ 0 ∧
         - 1*u^2 + 4 * t * v ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
               d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * x2 + e * x + f ≠ 0)"
            using tnonz alleqset discrh x_prop
            by auto
          then have "(∃(a', b', c')∈set c.  a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))" 
            using xis inset 
            by auto
          then show "False"
            using f13 by auto
        qed
        then show "False"
          using r1or2 r1 r2 by auto
      qed
      have case2: "(t = 0 ∧ u ≠ 0) ⟹ False" 
      proof -
        assume asm: "t = 0 ∧ u ≠ 0"
        then have xis: "x = - v / u" using def_prop notinb add.commute diff_0 divide_non_zero minus_add_cancel uminus_add_conv_diff
          by (metis mult_zero_left)
        have "((t = 0 ∧ u ≠ 0) ∧
         (∀(d, e, f)∈set a. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b. d * x^2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c. d * x^2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * x^2 + e * x + f ≠ 0))"
          using asm x_prop alleqset by auto
        then have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
          using xis inset
          by auto
        then show "False"
          using f8 by auto
      qed
      show "False"
        using def_prop case1 case2 by auto 
    qed
    have lengt0: "length ?srl ≥ 1 ⟹ False" 
    proof- 
      assume asm: "length ?srl ≥ 1"
        (* should violate f1 *)
      have cases_lt: "x < ?srl ! 0 ⟹ False" 
      proof - 
        assume xlt: "x < ?srl ! 0"
        have samesign: "∀ (a, b, c) ∈ (set b ∪ set c ∪ set d).
              (∀y < x. sign_num (a * y2 + b * y + c) =  sign_num (a*x^2 + b*x + c))"
        proof  clarsimp  
          fix t u v y
          assume insetunion: "(t, u, v) ∈ set b ∨ (t, u, v)  ∈ set c ∨ (t, u, v) ∈ set d"
          assume ylt: "y < x" 
          have tuzer: "t = 0 ∧ u = 0 ⟹ sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            unfolding sign_num_def 
            by auto
          have tunonzer: "t ≠ 0 ∨ u ≠ 0  ⟹ sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
          proof - 
            assume tuv_asm: "t≠ 0 ∨ u ≠ 0"
            have "¬(∃q. q < ?srl ! 0 ∧ t * q2 + u * q + v = 0)"
            proof clarsimp 
              fix q
              assume qlt: "q < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! 0"
              assume "t * q2 + u * q + v = 0"
              then have qin: "q ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
                using insetunion tuv_asm by auto
              have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
                unfolding sorted_nonzero_root_list_set_def
                using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                  nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
                by auto
              then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def
                by auto 
              then have lm: "List.member ?srl q"     
                using in_set_member[of q ?srl]
                by auto
              then have " List.member
                 (sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d)))
                 q ⟹
                q < sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d)) !
                    0 ⟹
                (⋀x xs. (x ∈ set xs) = (∃i<length xs. xs ! i = x)) ⟹
                (⋀x xs. (x ∈ set xs) = List.member xs x) ⟹
                (⋀y x. ¬ y ≤ x ⟹ x < y) ⟹
                (⋀xs. sorted xs =
                       (∀i j. i ≤ j ⟶ j < length xs ⟶ xs ! i ≤ xs ! j)) ⟹
                (⋀p. sorted_nonzero_root_list_set p ≡
                      sorted_list_of_set (nonzero_root_set p)) ⟹
                False"
              proof -
                assume a1: "List.member (sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d))) q"
                assume a2: "q < sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d)) ! 0"
                have f3: "List.member (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)}) q"
                  using a1 by (metis nonzero_root_set_def)
                have f4: "q < sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)} ! 0"
                  using a2 by (metis nonzero_root_set_def)
                have f5: "q ∈ set (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)})"
                  using f3 by (meson in_set_member)
                have "∀rs r. ∃n. ((r::real) ∉ set rs ∨ n < length rs) ∧ (r ∉ set rs ∨ rs ! n = r)"
                  by (metis in_set_conv_nth)
                then obtain nn :: "real list ⇒ real ⇒ nat" where
                  f6: "⋀r rs. (r ∉ set rs ∨ nn rs r < length rs) ∧ (r ∉ set rs ∨ rs ! nn rs r = r)"
                  by moura
                then have "sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)} ! nn (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)}) q = q"
                  using f5 by blast
                then have "⋀n. ¬ sorted (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)}) ∨ ¬ n ≤ nn (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)}) q ∨ ¬ nn (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)}) q < length (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)}) ∨ sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r2 + rb * r + rc = 0)} ! n ≤ q"
                  using not_less not_less0 sorted_iff_nth_mono
                  by (metis (no_types, lifting)) 
                then show ?thesis
                  using f6 f5 f4 by (meson le0 not_less sorted_sorted_list_of_set)
              qed 
              then show "False" using lm qlt in_set_conv_nth in_set_member not_le_imp_less not_less0 sorted_iff_nth_mono sorted_nonzero_root_list_set_def sorted_sorted_list_of_set
                by auto
            qed   
            then have "¬(∃q. q ≤ x ∧ t * q2 + u * q + v = 0)"
              using xlt
              by auto 
            then show " sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              using ylt changes_sign_var[of t y u v x]
              by blast
          qed
          then show " sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            using tuzer 
            by blast
        qed
        have bseth: "(∀(a, b, c)∈set b. ∀y<x. a * y2 + b * y + c < 0)" 
        proof clarsimp 
          fix t u v y
          assume insetb: "(t, u, v) ∈ set b"
          assume yltx: "y < x" 
          have "(t, u, v) ∈ (set b ∪ set c ∪ set d)" using insetb 
            by auto
          then have samesn: "sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            using samesign insetb yltx
            by blast 
          have "sign_num (t*x^2 + u*x + v) = -1" 
            using x_prop insetb unfolding sign_num_def
            by auto
          then show  "t * y2 + u * y + v < 0"
            using samesn unfolding sign_num_def 
            by (metis add.right_inverse add.right_neutral linorder_neqE_linordered_idom one_add_one zero_neq_numeral) 
        qed
        have bset: " (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0)"
        proof clarsimp 
          fix t u v
          assume inset: "(t, u, v) ∈ set b"
          then have " ∀y<x. t * y2 + u * y + v < 0 " using bseth by auto
          then show "∃x. ∀y<x. t * y2 + u * y + v < 0"
            by auto
        qed
        have cseth: "(∀(a, b, c)∈set c. ∀y<x. a * y2 + b * y + c ≤ 0)" 
        proof clarsimp 
          fix t u v y
          assume insetc: "(t, u, v) ∈ set c"
          assume yltx: "y < x" 
          have "(t, u, v) ∈ (set b ∪ set c ∪ set d)" using insetc
            by auto
          then have samesn: "sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            using samesign insetc yltx
            by blast 
          have "sign_num (t*x^2 + u*x + v) = -1 ∨ sign_num (t*x^2 + u*x + v) = 0" 
            using x_prop insetc unfolding sign_num_def
            by auto
          then show  "t * y2 + u * y + v ≤ 0"
            using samesn unfolding sign_num_def
            using zero_neq_one by fastforce
        qed
        have cset: " (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0)"
        proof clarsimp 
          fix t u v
          assume inset: "(t, u, v) ∈ set c"
          then have " ∀y<x. t * y2 + u * y + v ≤ 0 " using cseth by auto
          then show "∃x. ∀y<x. t * y2 + u * y + v ≤0"
            by auto
        qed
        have dseth: "(∀(a, b, c)∈set d. ∀y<x. a * y2 + b * y + c ≠ 0)" 
        proof clarsimp 
          fix t u v y
          assume insetd: "(t, u, v) ∈ set d"
          assume yltx: "y < x" 
          assume contrad: "t * y2 + u * y + v = 0"
          have "(t, u, v) ∈ (set b ∪ set c ∪ set d)" using insetd
            by auto
          then have samesn: "sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            using samesign insetd yltx
            by blast 
          have "sign_num (t*x^2 + u*x + v) = -1 ∨ sign_num (t*x^2 + u*x + v) = 1" 
            using x_prop insetd unfolding sign_num_def
            by auto
          then have  "t * y2 + u * y + v ≠ 0"
            using samesn unfolding sign_num_def 
            by auto
          then show "False" using contrad by auto
        qed
        have dset: " (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0)"
        proof clarsimp 
          fix t u v
          assume inset: "(t, u, v) ∈ set d"
          then have " ∀y<x. t * y2 + u * y + v ≠ 0 " using dseth by auto
          then show "∃x. ∀y<x. t * y2 + u * y + v ≠ 0"
            by auto
        qed
        have "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" 
          using alleqsetvar by auto 
        then have "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0))" 
          using  bset cset dset by auto
        then show "False" using f1 by auto
      qed
        (* should violate one of the infinitesmials *)
      have cases_gt: " x > ?srl ! (length ?srl - 1) ⟹ False" 
      proof - 
        assume xgt: "x > ?srl ! (length ?srl - 1)"
        let ?bgrt = "?srl ! (length ?srl - 1)"
        have samesign: "∀ (a, b, c) ∈ (set b ∪ set c ∪ set d).
              (∀y > ?bgrt. sign_num (a * y2 + b * y + c) =  sign_num (a*x^2 + b*x + c))"
        proof  clarsimp  
          fix t u v y
          assume insetunion: "(t, u, v) ∈ set b ∨ (t, u, v)  ∈ set c ∨ (t, u, v) ∈ set d"
          assume ygt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
              (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)  < y" 
          have tuzer: "t = 0 ∧ u = 0 ⟹ sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            unfolding sign_num_def 
            by auto
          have tunonzer: "t ≠ 0 ∨ u ≠ 0  ⟹ sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
          proof - 
            assume tuv_asm: "t≠ 0 ∨ u ≠ 0"
            have "¬(∃q. q > ?srl ! (length ?srl - 1) ∧ t * q2 + u * q + v = 0)"
            proof clarsimp 
              fix q
              assume qgt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
                (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < q"
              assume "t * q2 + u * q + v = 0"
              then have qin: "q ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
                using insetunion tuv_asm by auto
              have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
                unfolding sorted_nonzero_root_list_set_def
                using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                  nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
                by auto
              then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def
                by auto 
              then have "List.member ?srl q"     
                using in_set_member[of q ?srl]
                by auto
              then show "False" using qgt in_set_conv_nth in_set_member not_le_imp_less not_less0 sorted_iff_nth_mono sorted_nonzero_root_list_set_def sorted_sorted_list_of_set
                by (smt (z3) Suc_diff_Suc Suc_n_not_le_n ‹q ∈ set (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d))› in_set_conv_nth length_0_conv length_greater_0_conv length_sorted_list_of_set lenzero less_Suc_eq_le minus_nat.diff_0 not_le sorted_nth_mono sorted_sorted_list_of_set) 
            qed   
            then have nor: "¬(∃q. q > ?bgrt ∧ t * q2 + u * q + v = 0)"
              using xgt
              by auto 
            have c1: " x > y ⟹  sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              using nor changes_sign_var[of t y u v x] xgt ygt
              by fastforce 
            then have c2: " y > x ⟹  sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              using nor changes_sign_var[of t x u v y] xgt ygt
              by force
            then have c3: " x = y ⟹  sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              unfolding sign_num_def 
              by auto
            then show "sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              using c1 c2 c3
              by linarith
          qed
          then show " sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            using tuzer 
            by blast
        qed

        have "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" 
          using alleqsetvar by auto 
        have " ?bgrt ∈ set ?srl" 
          using set_sorted_list_of_set nonzero_root_set_finite in_set_member
          using asm by auto
        then have "?bgrt ∈ nonzero_root_set (set b ∪ set c ∪ set d )"
          unfolding sorted_nonzero_root_list_set_def
          using  set_sorted_list_of_set nonzero_root_set_finite 
          by auto
        then have "∃t u v. (t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)"
          unfolding nonzero_root_set_def by auto
        then obtain t u v where tuvprop1: "(t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)"
          by auto
        then have tuvprop: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0))
          ∨ ((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ∨
            ((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0))  "
          by auto
        have tnonz: "t≠ 0 ⟹ (-1*u^2 + 4 * t * v ≤ 0  ∧ (?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t) ∨ ?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)))"
        proof - 
          assume "t≠ 0"
          have "-1*u^2 + 4 * t * v ≤ 0 "  using tuvprop1 discriminant_negative[of t u v]
            unfolding discrim_def
            using ‹t ≠ 0› by force              
          then show ?thesis
            using tuvprop discriminant_nonneg[of t u v]
            unfolding discrim_def
            using ‹t ≠ 0› by auto 
        qed
        have unonz: "(t = 0 ∧ u ≠ 0) ⟹ ?bgrt = - v / u"
        proof - 
          assume "(t = 0 ∧ u ≠ 0)"
          then have "u*?bgrt + v = 0" using tuvprop1
            by simp 
          then show "?bgrt = - v / u"
            by (simp add: ‹t = 0 ∧ u ≠ 0› eq_minus_divide_eq mult.commute) 
        qed

        have allpropb: "(∀(d, e, f)∈set b.
              ∀y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0)" 
        proof clarsimp 
          fix t1 u1 v1 y1 x1
          assume ins: "(t1, u1, v1) ∈ set b"
          assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
       (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < x1"
          assume "x1 ≤ y1"
          have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1" using ins x_prop unfolding sign_num_def
            by auto
          have "sign_num (t1 * x12 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " 
            using ins x1gt samesign
            apply (auto) 
            by blast 
          then show "t1 * x12 + u1 * x1 + v1 < 0" using xsn unfolding sign_num_def
            by (metis add.right_inverse add.right_neutral linorder_neqE_linordered_idom one_add_one zero_neq_numeral) 
        qed
        have allpropbvar: "(∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0)" 
        proof clarsimp 
          fix t1 u1 v1
          assume "(t1, u1, v1) ∈ set b"
          then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x2 + u1 * x + v1 < 0"
            using allpropb
            by force 
          then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
           (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0).
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
               (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}.
             t1 * x2 + u1 * x + v1 < 0"
            using less_add_one
            by (metis One_nat_def)        
        qed
        have allpropc: "(∀(d, e, f)∈set c.
              ∀y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0)" 
        proof clarsimp 
          fix t1 u1 v1 y1 x1
          assume ins: "(t1, u1, v1) ∈ set c"
          assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
       (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < x1"
          assume "x1 ≤ y1"
          have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 0" using ins x_prop unfolding sign_num_def
            by auto
          have "sign_num (t1 * x12 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " 
            using ins x1gt samesign  One_nat_def
          proof -
            have "case (t1, u1, v1) of (r, ra, rb) ⇒ ∀raa>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1). sign_num (r * raa2 + ra * raa + rb) = sign_num (r * x2 + ra * x + rb)"
              by (smt (z3) Un_iff ins samesign)
            then show ?thesis
              by (simp add: x1gt)
          qed
          then show "t1 * x12 + u1 * x1 + v1 ≤ 0" using xsn unfolding sign_num_def
            by (metis equal_neg_zero less_numeral_extra(3) linorder_not_less zero_neq_one)
        qed
        have allpropcvar: "(∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0)" 
        proof clarsimp 
          fix t1 u1 v1
          assume "(t1, u1, v1) ∈ set c"
          then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x2 + u1 * x + v1 ≤ 0"
            using allpropc
            by force 
          then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
           (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0).
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
               (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}.
             t1 * x2 + u1 * x + v1 ≤ 0"
            using less_add_one One_nat_def
            by (metis (no_types, hide_lams))        
        qed
        have allpropd: "(∀(d, e, f)∈set d.
              ∀y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)" 
        proof clarsimp 
          fix t1 u1 v1 y1 x1
          assume ins: "(t1, u1, v1) ∈ set d"
          assume contrad:"t1 * x12 + u1 * x1 + v1 = 0"
          assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
       (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < x1"
          assume "x1 ≤ y1"
          have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 1" using ins x_prop unfolding sign_num_def
            by auto
          have "sign_num (t1 * x12 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " 
            using ins x1gt samesign apply (auto) 
            by blast 
          then have "t1 * x12 + u1 * x1 + v1 ≠ 0" using xsn unfolding sign_num_def 
            by auto
          then show "False" using contrad by auto
        qed
        have allpropdvar: "(∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)" 
        proof clarsimp 
          fix t1 u1 v1
          assume "(t1, u1, v1) ∈ set d"
          then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x2 + u1 * x + v1 ≠ 0"
            using allpropd
            by force 
          then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
           (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0).
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
               (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}.
             t1 * x2 + u1 * x + v1 ≠ 0"
            using less_add_one
            by (metis (no_types, hide_lams) One_nat_def)     
        qed
        have "∀x. (∀(d, e, f)∈set a.
             d * x2 + e * x + f = 0)" using alleqsetvar
          by auto
        then have ast: "(∀(d, e, f)∈set a.
             ∀x∈{?bgrt<..(?bgrt + 1)}. d * x2 + e * x + f = 0)"
          by auto
        have allpropavar: "(∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0)"
        proof clarsimp 
          fix t1 u1 v1 
          assume "(t1, u1, v1) ∈ set a"
          then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x2 + u1 * x + v1 = 0 "
            using ast by auto 
          then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
           (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0).
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) !
               (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}.
             t1 * x2 + u1 * x + v1 = 0"
            using less_add_one One_nat_def
            by metis
        qed
        have quadsetb: "((t, u, v) ∈ set b ∧ t≠ 0) ⟹ False"
        proof - 
          assume asm: "(t, u, v) ∈ set b ∧ t≠ 0"
          have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
          proof - 
            assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
            have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
              using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + 1 * sqrt (u2 - 4 * t * v)) / (2 * t)› 
              by auto 
            have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using f6 bgrtis 
              by auto
          qed
          have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
          proof -
            assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
            have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
              using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + -1 * sqrt (u2 - 4 * t * v)) / (2 * t)› 
              by auto
            have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using f7 bgrtis 
              by auto
          qed 
          show "False" using tnonz bgrt1 bgrt2 asm 
            by auto
        qed
        have linsetb: "((t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)) ⟹ False"
        proof - 
          assume asm: "(t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)"
          then have bgrtis: "?bgrt = (- v / u)"
            using unonz
            by blast 
          have "((t, u, v)∈set b ∧ (t = 0 ∧ u ≠ 0) ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
            using asm allpropavar allpropbvar allpropcvar allpropdvar
            by linarith
          then show "False" using bgrtis f5  
            by auto
        qed
        have insetb: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ⟹ False"
          using quadsetb linsetb by auto
        have quadsetc: "(t, u, v) ∈ set c ∧ t≠ 0 ⟹ False"
        proof - 
          assume asm: "(t, u, v) ∈ set c ∧ t≠ 0"
          have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
          proof - 
            assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
            have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
              using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + 1 * sqrt (u2 - 4 * t * v)) / (2 * t)› 
              by auto 
            have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using f13a bgrtis 
              by auto
          qed
          have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
          proof -
            assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
            have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
              using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + -1 * sqrt (u2 - 4 * t * v)) / (2 * t)› 
              by auto
            have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using f9a bgrtis 
              by auto
          qed 
          show "False" using tnonz bgrt1 bgrt2 asm 
            by auto
        qed
        have linsetc: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0) ⟹ False"
        proof - 
          assume asm: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0)"
          then have bgrtis: "?bgrt = (- v / u)"
            using unonz
            by blast 
          have "((t, u, v)∈set c ∧ (t = 0 ∧ u ≠ 0) ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
            using asm allpropavar allpropbvar allpropcvar allpropdvar
            by linarith
          then show "False" using bgrtis f8a  
            by auto
        qed
        have insetc: "((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ⟹ False"
          using quadsetc linsetc by auto
        have quadsetd: "(t, u, v) ∈ set d ∧ t≠ 0 ⟹ False"
        proof - 
          assume asm: "(t, u, v) ∈ set d ∧ t≠ 0"
          have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
          proof - 
            assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
            have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
              using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + 1 * sqrt (u2 - 4 * t * v)) / (2 * t)› 
              by auto 
            have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using f11 bgrtis 
              by auto
          qed
          have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
          proof -
            assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
            have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
              using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + -1 * sqrt (u2 - 4 * t * v)) / (2 * t)› 
              by auto
            have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using f12 bgrtis 
              by auto
          qed 
          show "False" using tnonz bgrt1 bgrt2 asm 
            by auto
        qed
        have linsetd: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0) ⟹ False"
        proof - 
          assume asm: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0)"
          then have bgrtis: "?bgrt = (- v / u)"
            using unonz
            by blast 
          have "((t, u, v)∈set d ∧ (t = 0 ∧ u ≠ 0) ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
            using asm allpropavar allpropbvar allpropcvar allpropdvar
            by linarith
          then show "False" using bgrtis f10
            by auto
        qed
        have insetd: "((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ⟹ False"
          using quadsetd linsetd by auto
        then show "False" using insetb insetc insetd tuvprop 
          by auto
      qed
      have len1: "length ?srl = 1 ⟹ False" 
      proof - 
        assume len1: "length ?srl = 1"
        have cases: "(List.member ?srl x) ∨ x < ?srl ! 0 ∨ x > ?srl ! 0"
          using in_set_member lenzero nth_mem by fastforce
        then show "False"
          using len1 cases_mem cases_lt cases_gt by auto
      qed
      have lengtone: "length ?srl > 1 ⟹ False" 
      proof - 
        assume lengt1: "length ?srl > 1" 
        have cases: "(List.member ?srl x) ∨ x < ?srl ! 0 ∨ x > ?srl ! (length ?srl -1)
                  ∨ (∃k ≤ (length ?srl - 2). (?srl ! k < x ∧ x <?srl ! (k + 1)))"
        proof -
          have eo: "x < ?srl ! 0 ∨ x > ?srl ! (length ?srl -1) ∨ (x ≥ ?srl ! 0 ∧ x ≤ ?srl ! (length ?srl -1))"
            by auto
          have ifo: "(x ≥ ?srl ! 0 ∧ x ≤ ?srl ! (length ?srl -1)) ⟹ ((List.member ?srl x) ∨ (∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)))"
          proof - 
            assume xinbtw: "x ≥ ?srl ! 0 ∧ x ≤ ?srl ! (length ?srl -1)"
            then have "¬(List.member ?srl x) ⟹  (∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1))"
            proof - 
              assume nonmem: "¬(List.member ?srl x)"
              have "¬(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)) ⟹ False"
              proof clarsimp
                assume "∀k. sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x ⟶
        k ≤ length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 2 ⟶
        ¬ x < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k"
                then have allk: "(∀k ≤ length ?srl - 2. ?srl ! k < x ⟶
        ¬ x < ?srl ! Suc k)" by auto 
                have basec: "x ≥ ?srl ! 0" using xinbtw by auto
                have "∀k ≤ length ?srl - 2. ?srl ! k < x" 
                proof clarsimp 
                  fix k
                  assume klteq: "k ≤ length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 2"
                  show "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x"
                    using nonmem klteq basec 
                  proof (induct k)
                    case 0
                    then show ?case
                      using in_set_member lenzero nth_mem by fastforce 
                  next
                    case (Suc k)
                    then show ?case
                      by (smt Suc_leD Suc_le_lessD ‹∀k. sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x ⟶ k ≤ length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 2 ⟶ ¬ x < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k› diff_less in_set_member length_0_conv length_greater_0_conv lenzero less_trans_Suc nth_mem pos2) 
                  qed
                qed
                then have "x ≥ ?srl ! (length ?srl -1)" 
                  using allk
                  by (metis One_nat_def Suc_diff_Suc lengt1 less_eq_real_def less_or_eq_imp_le one_add_one plus_1_eq_Suc xinbtw) 
                then have "x > ?srl ! (length ?srl - 1)" using nonmem
                  by (metis One_nat_def Suc_le_D asm diff_Suc_Suc diff_zero in_set_member lessI less_eq_real_def nth_mem) 
                then show "False" using xinbtw by auto
              qed
              then show "(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1))"
                by blast
            qed
            then show "((List.member ?srl x) ∨ (∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)))" 
              using sorted_nth_mono
              by auto 
          qed
          then show ?thesis using eo ifo by auto
        qed
          (* should violate one of the infinitesmials *)
        have cases_btw: "(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)) ⟹ False"
        proof - 
          assume "(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1))"
          then obtain k where k_prop: "k ≤ (length ?srl - 2) ∧ ?srl ! k < x ∧ x <?srl ! (k + 1)"
            by auto
          have samesign: "∀ (a, b, c) ∈ (set b ∪ set c ∪ set d).
              (∀y. (?srl ! k < y ∧ y <?srl ! (k + 1)) ⟶ sign_num (a * y2 + b * y + c) =  sign_num (a*x^2 + b*x + c))"
          proof  clarsimp  
            fix t u v y
            assume insetunion: "(t, u, v) ∈ set b ∨ (t, u, v)  ∈ set c ∨ (t, u, v) ∈ set d"
            assume ygt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < y" 
            assume ylt: "y < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k"
            have tuzer: "t = 0 ∧ u = 0 ⟹ sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              unfolding sign_num_def 
              by auto
            have tunonzer: "t ≠ 0 ∨ u ≠ 0  ⟹ sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
            proof - 
              assume tuv_asm: "t≠ 0 ∨ u ≠ 0"
              have nor: "¬(∃q. q > ?srl ! k ∧ q < ?srl ! (k + 1) ∧ t * q2 + u * q + v = 0)"
              proof clarsimp 
                fix q
                assume qlt: "q < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k"
                assume qgt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < q"
                assume "t * q2 + u * q + v = 0"
                then have qin: "q ∈  {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x2 + b * x + c = 0}"
                  using insetunion tuv_asm by auto
                have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)"
                  unfolding sorted_nonzero_root_list_set_def
                  using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"]
                    nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"]
                  by auto
                then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def
                  by auto 
                then have "List.member ?srl q"     
                  using in_set_member[of q ?srl]
                  by auto
                then have "∃n < length ?srl. q = ?srl ! n"
                  by (metis ‹q ∈ set (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d))› in_set_conv_nth) 
                then obtain n where nprop: "n < length ?srl ∧ q = ?srl ! n" by auto
                then have ngtk: "n > k"
                proof - 
                  have sortedh: "sorted ?srl"
                    by (simp add: sorted_nonzero_root_list_set_def) 
                  then have nlteq: "n ≤ k ⟹ ?srl ! n ≤ ?srl ! k" using nprop k_prop sorted_iff_nth_mono
                    using sorted_nth_mono
                    by (metis (no_types, hide_lams) Suc_1 ‹q ∈ set (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d))› diff_Suc_less length_pos_if_in_set sup.absorb_iff2 sup.strict_boundedE) 
                  have "?srl ! n > ?srl ! k" using nprop qgt by auto
                  then show ?thesis
                    using nlteq
                    by linarith 
                qed
                then have nltkp1: "n < k+1"
                proof - 
                  have sortedh: "sorted ?srl"
                    by (simp add: sorted_nonzero_root_list_set_def) 
                  then have ngteq: "k+1 ≤ n ⟹ ?srl ! (k+1) ≤ ?srl ! n" using nprop k_prop sorted_iff_nth_mono
                    by auto
                  have "?srl ! n < ?srl ! (k + 1)" using nprop qlt by auto
                  then show ?thesis
                    using ngteq by linarith
                qed
                then show "False" using ngtk nltkp1 by auto
              qed
              have c1: " x > y ⟹  sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
                using nor changes_sign_var[of t y u v x] k_prop ygt ylt
                by fastforce 
              then have c2: " y > x ⟹  sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
                using nor changes_sign_var[of t x u v y] k_prop ygt ylt
                by force
              then have c3: " x = y ⟹  sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
                unfolding sign_num_def 
                by auto
              then show "sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
                using c1 c2 c3
                by linarith
            qed
            then show " sign_num (t * y2 + u * y + v) = sign_num (t * x2 + u * x + v)"
              using tuzer 
              by blast
          qed

          let ?bgrt = "?srl ! k"

          have "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" 
            using alleqsetvar by auto 
          have " ?bgrt ∈ set ?srl" 
            using set_sorted_list_of_set nonzero_root_set_finite in_set_member k_prop asm
            by (smt diff_Suc_less le_eq_less_or_eq less_le_trans nth_mem one_add_one plus_1_eq_Suc zero_less_one)
          then have "?bgrt ∈ nonzero_root_set (set b ∪ set c ∪ set d )"
            unfolding sorted_nonzero_root_list_set_def
            using  set_sorted_list_of_set nonzero_root_set_finite 
            by auto
          then have "∃t u v. (t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)"
            unfolding nonzero_root_set_def by auto
          then obtain t u v where tuvprop1: "(t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)"
            by auto
          then have tuvprop: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0))
          ∨ ((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ∨
            ((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0))  "
            by auto
          have tnonz: "t≠ 0 ⟹ (-1*u^2 + 4 * t * v ≤ 0  ∧ (?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t) ∨ ?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)))"
          proof - 
            assume "t≠ 0"
            have "-1*u^2 + 4 * t * v ≤ 0 "  using tuvprop1 discriminant_negative[of t u v]
              unfolding discrim_def
              using ‹t ≠ 0› by force              
            then show ?thesis
              using tuvprop discriminant_nonneg[of t u v]
              unfolding discrim_def
              using ‹t ≠ 0› by auto 
          qed
          have unonz: "(t = 0 ∧ u ≠ 0) ⟹ ?bgrt = - v / u"
          proof - 
            assume "(t = 0 ∧ u ≠ 0)"
            then have "u*?bgrt + v = 0" using tuvprop1
              by simp 
            then show "?bgrt = - v / u"
              by (simp add: ‹t = 0 ∧ u ≠ 0› eq_minus_divide_eq mult.commute) 
          qed

          have "∃y'. y' > x ∧ y' < ?srl ! (k+1)" using k_prop dense
            by blast 
          then obtain y1 where y1_prop: "y1 > x ∧ y1 < ?srl ! (k+1)" by auto
          then have y1inbtw: "y1 > ?srl ! k ∧ y1 < ?srl ! (k+1)" using k_prop
            by auto

          have allpropb: "(∀(d, e, f)∈set b.
             ∀x∈{?bgrt<..y1}. d * x2 + e * x + f < 0)" 
          proof clarsimp 
            fix t1 u1 v1 x1
            assume ins: "(t1, u1, v1) ∈ set b"
            assume x1gt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x1"
            assume x1lt: "x1 ≤ y1"
            have x1inbtw: "x1 > ?srl ! k ∧ x1 < ?srl ! (k+1)"
              using x1gt x1lt y1inbtw
              by (smt One_nat_def cases_gt k_prop) 
            have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1" using ins x_prop unfolding sign_num_def
              by auto
            have "sign_num (t1 * x12 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " 
              using ins x1inbtw samesign
              by blast 
            then show "t1 * x12 + u1 * x1 + v1 < 0" using xsn unfolding sign_num_def 
              by (metis add.right_inverse add.right_neutral linorder_neqE_linordered_idom one_add_one zero_neq_numeral) 
          qed
          have allpropbvar: "(∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0)" 
          proof clarsimp 
            fix t1 u1 v1
            assume "(t1, u1, v1) ∈ set b"
            then have "∀x∈{?bgrt<..y1}. t1 * x2 + u1 * x + v1 < 0"
              using allpropb
              by force 
            then show " ∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k.
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}.
             t1 * x2 + u1 * x + v1 < 0" 
              using y1inbtw by blast 
          qed
          have allpropc: "(∀(d, e, f)∈set c.
               ∀x∈{?bgrt<..y1}. d * x2 + e * x + f ≤ 0)" 
          proof clarsimp 
            fix t1 u1 v1 x1
            assume ins: "(t1, u1, v1) ∈ set c"
            assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x1"
            assume x1lt: "x1 ≤ y1"
            have x1inbtw: "x1 > ?srl ! k ∧ x1 < ?srl ! (k+1)"
              using x1gt x1lt y1inbtw
              by (smt One_nat_def cases_gt k_prop) 
            have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 0" using ins x_prop unfolding sign_num_def
              by auto
            have "sign_num (t1 * x12 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " 
              using ins x1inbtw samesign
              by blast 
            then show "t1 * x12 + u1 * x1 + v1 ≤ 0" using xsn unfolding sign_num_def
              by (metis (no_types, hide_lams) equal_neg_zero less_eq_real_def linorder_not_less zero_neq_one) 
          qed
          have allpropcvar: "(∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0)" 
          proof clarsimp 
            fix t1 u1 v1
            assume "(t1, u1, v1) ∈ set c"
            then have "∀x∈{?bgrt<..y1}. t1 * x2 + u1 * x + v1 ≤ 0"
              using allpropc 
              by force 
            then show " ∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k.
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}.
             t1 * x2 + u1 * x + v1 ≤ 0" 
              using y1inbtw by blast 
          qed
          have allpropd: "(∀(d, e, f)∈set d.
              ∀x∈{?bgrt<..y1}. d * x2 + e * x + f ≠ 0)" 
          proof clarsimp 
            fix t1 u1 v1 x1
            assume ins: "(t1, u1, v1) ∈ set d"
            assume contrad:"t1 * x12 + u1 * x1 + v1 = 0"
            assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x1"
            assume x1lt: "x1 ≤ y1"
            have x1inbtw: "x1 > ?srl ! k ∧ x1 < ?srl ! (k+1)"
              using x1gt x1lt y1inbtw
              by (smt One_nat_def cases_gt k_prop) 
            have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 1" using ins x_prop unfolding sign_num_def
              by auto
            have "sign_num (t1 * x12 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " 
              using ins x1inbtw samesign
              by blast
            then have "t1 * x12 + u1 * x1 + v1 ≠ 0" using xsn unfolding sign_num_def 
              by auto
            then show "False" using contrad by auto
          qed
          have allpropdvar: "(∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)" 
          proof clarsimp 
            fix t1 u1 v1
            assume "(t1, u1, v1) ∈ set d"
            then have "∀x∈{?bgrt<..y1}. t1 * x2 + u1 * x + v1 ≠ 0"
              using allpropd
              by force 
            then show " ∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k.
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}.
             t1 * x2 + u1 * x + v1 ≠ 0" 
              using y1inbtw by blast 
          qed
          have "∀x. (∀(d, e, f)∈set a.
             d * x2 + e * x + f = 0)" using alleqsetvar
            by auto
          then have ast: "(∀(d, e, f)∈set a.
             ∀x∈{?bgrt<..(?bgrt + 1)}. d * x2 + e * x + f = 0)"
            by auto
          have allpropavar: "(∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0)"
          proof clarsimp 
            fix t1 u1 v1 
            assume "(t1, u1, v1) ∈ set a"
            then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x2 + u1 * x + v1 = 0 "
              using ast by auto 
            then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k.
          ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}.
             t1 * x2 + u1 * x + v1 = 0" 
              using less_add_one by blast 
          qed

          have quadsetb: "((t, u, v) ∈ set b ∧ t≠ 0) ⟹ False"
          proof - 
            assume asm: "(t, u, v) ∈ set b ∧ t≠ 0"
            have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
            proof - 
              assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
              have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
                by blast           
              have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
                using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
                by linarith
              then show "False" using f6 bgrtis 
                by auto
            qed
            have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
            proof -
              assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
              have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
                by blast
              have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
                using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
                by linarith
              then show "False" using f7 bgrtis 
                by auto
            qed 
            show "False" using tnonz bgrt1 bgrt2 asm 
              by auto
          qed
          have linsetb: "((t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)) ⟹ False"
          proof - 
            assume asm: "(t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)"
            then have bgrtis: "?bgrt = (- v / u)"
              using unonz
              by blast 
            have "((t, u, v)∈set b ∧ (t = 0 ∧ u ≠ 0) ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using bgrtis f5  
              by auto
          qed
          have insetb: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ⟹ False"
            using quadsetb linsetb by auto
          have quadsetc: "(t, u, v) ∈ set c ∧ t≠ 0 ⟹ False"
          proof - 
            assume asm: "(t, u, v) ∈ set c ∧ t≠ 0"
            have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
            proof - 
              assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
              have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
                by blast 
              have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
                using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
                by linarith
              then show "False" using f13a bgrtis 
                by auto
            qed
            have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
            proof -
              assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
              have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
                by blast
              have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
                using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
                by linarith
              then show "False" using f9a bgrtis 
                by auto
            qed 
            show "False" using tnonz bgrt1 bgrt2 asm 
              by auto
          qed
          have linsetc: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0) ⟹ False"
          proof - 
            assume asm: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0)"
            then have bgrtis: "?bgrt = (- v / u)"
              using unonz
              by blast 
            have "((t, u, v)∈set c ∧ (t = 0 ∧ u ≠ 0) ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using bgrtis f8a  
              by auto
          qed
          have insetc: "((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ⟹ False"
            using quadsetc linsetc by auto
          have quadsetd: "(t, u, v) ∈ set d ∧ t≠ 0 ⟹ False"
          proof - 
            assume asm: "(t, u, v) ∈ set d ∧ t≠ 0"
            have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
            proof - 
              assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
              have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
                by blast
              have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
                using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
                by linarith
              then show "False" using f11 bgrtis 
                by auto
            qed
            have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False "
            proof -
              assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)"
              have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz
                by blast
              have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
                using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar
                by linarith
              then show "False" using f12 bgrtis 
                by auto
            qed 
            show "False" using tnonz bgrt1 bgrt2 asm 
              by auto
          qed
          have linsetd: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0) ⟹ False"
          proof - 
            assume asm: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0)"
            then have bgrtis: "?bgrt = (- v / u)"
              using unonz
              by blast 
            have "((t, u, v)∈set d ∧ (t = 0 ∧ u ≠ 0) ∧
         ((∀(d, e, f)∈set a.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x2 + e * x + f ≠ 0)))"
              using asm allpropavar allpropbvar allpropcvar allpropdvar
              by linarith
            then show "False" using bgrtis f10
              by auto
          qed
          have insetd: "((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt2 + u * ?bgrt + v = 0)) ⟹ False"
            using quadsetd linsetd by auto
          then show "False" using insetb insetc insetd tuvprop 
            by auto
        qed
        show "False" using cases cases_btw cases_mem cases_lt cases_gt 
          by auto
      qed
      show "False" using asm len1 lengtone
        by linarith 
    qed
    show "False" using lenzero lengt0
      by linarith 
  qed
  then show ?thesis
    by blast  
qed


lemma qe_forwards: 
  assumes "(∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
  shows "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) ∨
     (∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0) ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0))) ∨
     (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) ∨
     (∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0) ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0))) ∨
     (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))))" 
    (* using eq_qe_1 les_qe_1 *)
proof -
  let ?e2 = "(((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) 
     ∨
     (∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)         
          ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))) 
    ∨
     (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) 
    ∨
     (∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))) 
      ∨
     (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))))"
  let ?f10orf11orf12 = "(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f8orf9 = "(∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  let ?f5orf6orf7 = "(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f2orf3orf4 = "(∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)         
          ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  let ?e1 = "(∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
  let ?f1 = "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0))"
  let ?f2 = "(∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
  let ?f3 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'2 + 4 * a' * c' ≤ 0 ∧
         (∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))"
  let ?f4 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'2 + 4 * a' * c' ≤ 0 ∧
 (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)) "
  let ?f5 = "(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  let ?f6 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f7 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  let ?f8 = "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
  let ?f13 = "(∃(a', b', c')∈set c.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  let ?f9 = "(∃(a', b', c')∈set c.  a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))"
  let ?f10 = "(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  let ?f11 = "(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f12 = "(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  have h1a: "(?f1 ∨ ?f2orf3orf4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12) ⟶ ?e2"
    by auto
  have h2: "(?f2 ∨ ?f3 ∨ ?f4) ⟶ ?f2orf3orf4" by auto
  then have h1b: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12) ⟶ ?e2"
    using h1a by auto
  have h3: "(?f5 ∨ ?f6 ∨ ?f7) ⟶ ?f5orf6orf7" by auto
  then have h1c: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8orf9 ∨ ?f10orf11orf12) ⟶ ?e2"
    using h1b by smt 
  have h4: "(?f8 ∨ ?f9 ∨ ?f13) ⟶ ?f8orf9" by auto
  then have h1d: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f9 ∨ ?f13 ∨ ?f10orf11orf12) ⟶ ?e2"
    using h1c
    by smt 
  have h5: "(?f10 ∨ ?f11 ∨ ?f12) ⟶ ?f10orf11orf12" 
    by auto
  then have bigor: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12)
    ⟶ ?e2 "
    using h1d  by smt 
  then have bigor_var: "¬?e2 ⟶ ¬(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12)
   " using contrapos_nn
    by smt 
  have not_eq: "¬(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12) 
=(¬?f1 ∧ ¬?f2  ∧ ¬?f3  ∧ ¬?f4  ∧ ¬?f5 ∧ ¬?f6 ∧ ¬?f7 ∧ ¬?f8 ∧ ¬?f13 ∧ ¬?f9 ∧ ¬?f10 ∧ ¬?f11 ∧ ¬?f12) "
    by linarith
  obtain x where x_prop: "(∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" using assms by auto
  have "(¬?f1 ∧ ¬?f2  ∧ ¬?f3  ∧ ¬?f4  ∧ ¬?f5 ∧ ¬?f6 ∧ ¬?f7 ∧ ¬?f8 ∧ ¬?f13 ∧ ¬?f9 ∧ ¬?f10 ∧ ¬?f11 ∧ ¬?f12) ⟹ False"
  proof - 
    assume big_not: " ¬ ((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
        (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
        (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
        (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set a.
           (a' = 0 ∧ b' ≠ 0) ∧
           (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
           (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
           (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
           (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set a.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f = 0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set a.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f = 0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set b.
           (a' = 0 ∧ b' ≠ 0) ∧
           (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
           (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
           (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
           (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set b.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f = 0) ∧
           (∀(d, e, f)∈set b.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f < 0) ∧
           (∀(d, e, f)∈set c.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set b.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f = 0) ∧
           (∀(d, e, f)∈set b.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f < 0) ∧
           (∀(d, e, f)∈set c.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set c.
           (a' = 0 ∧ b' ≠ 0) ∧
           (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
           (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
           (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
           (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set c.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f =
               0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f
               < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f
               ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠
               0)) ∧
    ¬ (∃(a', b', c')∈set c.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f =
               0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f
               < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f
               ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠
               0)) ∧
    ¬ (∃(a', b', c')∈set d.
           (a' = 0 ∧ b' ≠ 0) ∧
           (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
           (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
           (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
           (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set d.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f = 0) ∧
           (∀(d, e, f)∈set b.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f < 0) ∧
           (∀(d, e, f)∈set c.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≠ 0)) ∧
    ¬ (∃(a', b', c')∈set d.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f = 0) ∧
           (∀(d, e, f)∈set b.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f < 0) ∧
           (∀(d, e, f)∈set c.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                  ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                     d * x2 + e * x + f ≠ 0))"
    have c1: "(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e2 + 4 * d * f ≤ 0) ⟹ False"
    proof - 
      assume "(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e2 + 4 * d * f ≤ 0)"
      then obtain a' b' c' where abc_prop:  "(a', b', c') ∈ set a ∧ a' ≠ 0 ∧ - b'2 + 4 * a' * c' ≤ 0"
        by auto
      then have "a'*x^2 + b'*x + c' = 0" using x_prop by auto
      then have xis: "x = (- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a') ∨ x = (- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a') " 
        using abc_prop discriminant_nonneg[of a' b' c'] unfolding discrim_def
        by auto 
      then have "((∀(d, e, f)∈set a.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f = 0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠ 0)) ∨
        ((∀(d, e, f)∈set a.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f = 0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠ 0))"
        using x_prop by auto
      then have "(∃(a', b', c')∈set a.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f = 0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠ 0)) ∨
        (∃(a', b', c')∈set a.
           a' ≠ 0 ∧
           - b'2 + 4 * a' * c' ≤ 0 ∧
           (∀(d, e, f)∈set a.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f = 0) ∧
           (∀(d, e, f)∈set b.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f < 0) ∧
           (∀(d, e, f)∈set c.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≤ 0) ∧
           (∀(d, e, f)∈set d.
               d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
               e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
               f ≠ 0))" using abc_prop xis by auto
      then show "False"
        using big_not by auto
    qed
    have c2: "(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0) ⟹ False"
    proof - 
      assume "(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0)"
      then obtain a' b' c' where abc_prop: "(a', b', c') ∈ set a ∧ a' = 0 ∧ b' ≠ 0" by auto 
      then have "a'*x^2 + b'*x + c' = 0" using x_prop by auto
      then have "b'*x + c' = 0" using abc_prop by auto
      then have xis: "x = - c' / b'" using abc_prop
        by (smt divide_non_zero)
      then have "(∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
           (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
           (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
           (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)" 
        using x_prop by auto 
      then have "(∃(a', b', c')∈set a.
           (a' = 0 ∧ b' ≠ 0) ∧
           (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
           (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
           (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
           (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
        using abc_prop xis by auto
      then show "False"
        using big_not by auto 
    qed
    have c3: "(∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0) ⟹ False"
    proof - 
      assume "(∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)"
      then have equalset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)"
        using case_prodE by auto
      have "¬?f5 ∧ ¬?f6 ∧ ¬?f7 ∧ ¬?f8 ∧ ¬?f13 ∧ ¬?f9 ∧ ¬?f10 ∧ ¬?f11 ∧ ¬?f12"
        using big_not by auto
      then have "¬(∃x. (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
        using equalset big_not qe_forwards_helper[of a b c d] by auto
      then show "False"
        using x_prop by auto
    qed
    have eo: "(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e2 + 4 * d * f ≤ 0) ∨ (∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0) ∨ (∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)"
    proof - 
      have  "(∀ (d, e, f) ∈ set a. (d ≠ 0 ⟶  - e2 + 4 * d * f ≤ 0))"
      proof clarsimp 
        fix d e f
        assume in_set: " (d, e, f) ∈ set a"
        assume dnonz: "d ≠ 0"
        have "d*x^2 + e*x + f = 0" using in_set x_prop by auto 
        then show " 4 * d * f ≤ e2"
          using dnonz discriminant_negative[of d e f] unfolding discrim_def
          by fastforce 
      qed
      then have discrim_prop: "¬(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e2 + 4 * d * f ≤ 0) ⟹ ¬(∃ (d, e, f) ∈ set a. d ≠ 0)"
        by auto
      have "¬(∃ (d, e, f) ∈ set a. d ≠ 0) ∧ ¬(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0) ⟹ (∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)"
      proof - 
        assume ne: "¬(∃ (d, e, f) ∈ set a. d ≠ 0) ∧ ¬(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0)"
        show "(∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)"
        proof clarsimp 
          fix d e f 
          assume in_set: "(d, e, f) ∈set a"
          then have xzer: "d*x^2 + e*x + f = 0" using x_prop by auto
          have dzer: "d = 0" using ne in_set by auto
          have ezer: "e = 0" using ne in_set by auto
          show "d = 0 ∧ e = 0 ∧ f = 0" using xzer dzer ezer by auto 
        qed
      qed
      then show ?thesis using discrim_prop by auto
    qed
    show "False" using c1 c2 c3 eo by auto 
  qed
  then have " ¬?e2 ⟹ False" using bigor_var not_eq
    by presburger (* Takes a second *) 
  then have " ¬?e2 ⟶ False" using impI[of "¬?e2" "False"]
    by blast 
  then show ?thesis 
    by auto
qed

subsubsection "Some Cases and Misc"
lemma quadratic_linear :
  assumes "b≠0"
  assumes "a ≠ 0"
  assumes "4 * a * ba ≤ aa2"
  assumes "b * (sqrt (aa2 - 4 * a * ba) - aa) / (2 * a) + c = 0"
  assumes "∀x∈set eq.
          case x of
          (d, e, f) ⇒
            d * ((sqrt (aa2 - 4 * a * ba) - aa) / (2 * a))2 +
            e * (sqrt (aa2 - 4 * a * ba) - aa) / (2 * a) +
            f =
            0"
  assumes "(aaa, aaaa, baa) ∈ set eq"
  shows "aaa * (c / b)2 - aaaa * c / b + baa = 0"
proof-
  have h:  "-(c/b) = (sqrt (aa2 - 4 * a * ba) - aa) / (2 * a)"
    using assms
    by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right)
  have h1 : "∀x∈set eq. case x of (d, e, f) ⇒ d * (c / b)2 + e * - (c / b) + f = 0"
    using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric]
      Power.ring_1_class.power2_minus .
  show ?thesis  
    using bspec[OF h1 assms(6)] by simp
qed

lemma quadratic_linear1:  
  assumes "b≠0"
  assumes "a ≠ 0"
  assumes "4 * a * ba ≤ aa2"
  assumes "(b::real) * (sqrt ((aa::real)2 - 4 * (a::real) * (ba::real)) - (aa::real)) / (2 * a) + (c::real) = 0"
  assumes "
       (∀x∈set (les::(real*real*real)list).
          case x of
          (d, e, f) ⇒
            d * ((sqrt (aa2 - 4 * a * ba) - aa) / (2 * a))2 +
            e * (sqrt (aa2 - 4 * a * ba) - aa) / (2 * a) +
            f
            < 0)"
  assumes "(aaa, aaaa, baa) ∈ set les"
  shows "aaa * (c / b)2 - aaaa * c / b + baa < 0"
proof-
  have h:  "-(c/b) = (sqrt (aa2 - 4 * a * ba) - aa) / (2 * a)"
    using assms
    by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right)
  have h1 : "∀x∈set les. case x of (d, e, f) ⇒ d * (c / b)2 + e * - (c / b) + f < 0"
    using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric]
      Power.ring_1_class.power2_minus .
  show ?thesis  
    using bspec[OF h1 assms(6)] by simp
qed

lemma quadratic_linear2 :
  assumes "b≠0"
  assumes "a ≠ 0"
  assumes "4 * a * ba ≤ aa2"
  assumes "b * (- aa -sqrt (aa2 - 4 * a * ba)) / (2 * a) + c = 0"
  assumes "∀x∈set eq.
          case x of
          (d, e, f) ⇒
            d * ((- aa -sqrt (aa2 - 4 * a * ba)) / (2 * a))2 +
            e * (- aa -sqrt (aa2 - 4 * a * ba)) / (2 * a) +
            f =
            0"
  assumes "(aaa, aaaa, baa) ∈ set eq"
  shows "aaa * (c / b)2 - aaaa * c / b + baa = 0"
proof-
  have h:  "-((c::real)/(b::real)) = (- (aa::real) -sqrt (aa2 - 4 * (a::real) * (ba::real))) / (2 * a)"
    using assms
    by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right)
  have h1 : "∀x∈set eq. case x of (d, e, f) ⇒ d * (c / b)2 + e * - (c / b) + f = 0"
    using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric]
      Power.ring_1_class.power2_minus .
  show ?thesis  
    using bspec[OF h1 assms(6)] by simp
qed

lemma quadratic_linear3:  
  assumes "b≠0"
  assumes "a ≠ 0"
  assumes "4 * a * ba ≤ aa2"
  assumes "(b::real) * (- (aa::real)- sqrt ((aa::real)2 - 4 * (a::real) * (ba::real)) ) / (2 * a) + (c::real) = 0"
  assumes "(∀x∈set (les::(real*real*real)list).
          case x of
          (d, e, f) ⇒
            d * ((- aa - sqrt (aa2 - 4 * a * ba)) / (2 * a))2 +
            e * (- aa - sqrt (aa2 - 4 * a * ba)) / (2 * a) +
            f
            < 0)"
  assumes "(aaa, aaaa, baa) ∈ set les"
  shows "aaa * (c / b)2 - aaaa * c / b + baa < 0"
proof-
  have h:  "-((c::real)/(b::real)) = (- (aa::real) -sqrt (aa2 - 4 * (a::real) * (ba::real))) / (2 * a)"
    using assms
    by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right)
  have h1 : "∀x∈set les. case x of (d, e, f) ⇒ d * (c / b)2 + e * - (c / b) + f < 0"
    using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric]
      Power.ring_1_class.power2_minus .
  show ?thesis  
    using bspec[OF h1 assms(6)] by simp
qed


lemma h1b_helper_les: 
  "(∀((a::real), (b::real), (c::real))∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))"
proof - 
  show "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x2 + b * x + c < 0))" 
  proof (induct les)
    case Nil
    then show ?case
      by auto
  next
    case (Cons q les) 
    have ind: " ∀a∈set (q # les). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0"
      using Cons.prems
      by auto
    then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0 "
      by simp      
    then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒  (∀y<y2. a * y2 + ba * y + c < 0)"
      by auto
    have "∀a∈set les. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0"
      using ind by simp
    then have " ∃y. ∀x<y. ∀a∈set les. case a of (a, ba, c) ⇒ a * x2 + ba * x + c < 0"
      using Cons.hyps by blast 
    then obtain y1 where y1_prop: "∀x<y1. ∀a∈set les. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0"
      by blast
    let ?y = "min y1 y2"
    have "∀x < ?y.  (∀a∈set (q #les). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0)"
      using y1_prop y2_prop 
      by fastforce 
    then show ?case
      by blast 
  qed
qed

lemma h1b_helper_leq: 
  "(∀((a::real), (b::real), (c::real))∈set leq. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set leq. a * x2 + b * x + c ≤ 0))"
proof - 
  show "(∀(a, b, c)∈set leq. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set leq. a * x2 + b * x + c ≤ 0))" 
  proof (induct leq)
    case Nil
    then show ?case
      by auto
  next
    case (Cons q leq) 
    have ind: " ∀a∈set (q # leq). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0"
      using Cons.prems
      by auto
    then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0 "
      by simp      
    then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒  (∀y<y2. a * y2 + ba * y + c ≤ 0)"
      by auto
    have "∀a∈set leq. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0"
      using ind by simp
    then have " ∃y. ∀x<y. ∀a∈set leq. case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≤ 0"
      using Cons.hyps by blast 
    then obtain y1 where y1_prop: "∀x<y1. ∀a∈set leq. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≤ 0"
      by blast
    let ?y = "min y1 y2"
    have "∀x < ?y.  (∀a∈set (q #leq). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≤ 0)"
      using y1_prop y2_prop 
      by fastforce 
    then show ?case
      by blast 
  qed
qed

lemma h1b_helper_neq: 
  "(∀((a::real), (b::real), (c::real))∈set neq. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set neq. a * x2 + b * x + c ≠ 0))"
proof - 
  show "(∀(a, b, c)∈set neq. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set neq. a * x2 + b * x + c ≠ 0))" 
  proof (induct neq)
    case Nil
    then show ?case
      by auto
  next
    case (Cons q neq) 
    have ind: " ∀a∈set (q # neq). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0"
      using Cons.prems
      by auto
    then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0 "
      by simp      
    then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒  (∀y<y2. a * y2 + ba * y + c ≠ 0)"
      by auto
    have "∀a∈set neq. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0"
      using ind by simp
    then have " ∃y. ∀x<y. ∀a∈set neq. case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≠ 0"
      using Cons.hyps by blast 
    then obtain y1 where y1_prop: "∀x<y1. ∀a∈set neq. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≠ 0"
      by blast
    let ?y = "min y1 y2"
    have "∀x < ?y.  (∀a∈set (q #neq). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≠ 0)"
      using y1_prop y2_prop 
      by fastforce 
    then show ?case
      by blast 
  qed
qed


lemma min_lem: 
  fixes r::"real"
  assumes a1: "(∃y'>r. (∀((d::real), (e::real), (f::real))∈set b. ∀x∈{r<..y'}. d * x2 + e * x + f < 0))" 
  assumes a2: "(∃y'>r. (∀((d::real), (e::real), (f::real))∈set c. ∀x∈{r<..y'}. d * x2 + e * x + f ≤ 0))"
  assumes a3: "(∃y'>r. (∀((d::real), (e::real), (f::real))∈set d. ∀x∈{r<..y'}. d * x2 + e * x + f ≠ 0))" 
  shows "(∃x. (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
proof - 
  obtain y1 where y1_prop: "y1 > r ∧ (∀(d, e, f)∈set b.  ∀x∈{r<..y1}. d * x2 + e * x + f < 0)"
    using a1 by auto
  obtain y2 where y2_prop: "y2 > r ∧ (∀(d, e, f)∈set c.  ∀x∈{r<..y2}. d * x2 + e * x + f ≤ 0)"
    using a2 by auto
  obtain y3 where y3_prop: "y3 > r ∧ (∀(d, e, f)∈set d.  ∀x∈{r<..y3}. d * x2 + e * x + f ≠ 0)"
    using a3 by auto
  let ?y = "(min (min y1 y2) y3)"
  have "?y > r" using y1_prop y2_prop y3_prop by auto
  then have "∃x. x > r ∧ x < ?y" using dense[of r ?y] 
    by auto
  then obtain x where x_prop: "x > r ∧ x < ?y" by auto
  have bp: "(∀(a, b, c)∈set b. a *x2 + b * x + c < 0)"  
    using x_prop y1_prop by auto 
  have cp: "(∀(a, b, c)∈set c. a * x^2 + b * x + c ≤ 0)"  
    using x_prop y2_prop by auto 
  have dp: "(∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)"  
    using x_prop y3_prop by auto 
  then have  "(∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
        (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)"
    using  bp cp dp by auto
  then show ?thesis by auto
qed 

lemma qe_infinitesimals_helper:
  fixes k::"real"
  assumes asm: "(∀(d, e, f)∈set a. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d. ∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f ≠ 0)"
  shows "(∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
proof -
  have "∀(d, e, f)∈set a. d = 0 ∧ e = 0 ∧ f = 0" 
  proof clarsimp 
    fix d e f
    assume "(d, e, f) ∈ set a"
    then have "∃y'>k. ∀x∈{k<..y'}. d * x2 + e * x + f = 0"
      using asm by auto
    then obtain y' where y_prop: "y'>k ∧ (∀x∈{k<..y'}. d * x2 + e * x + f = 0)"
      by auto
    then show "d = 0 ∧ e = 0 ∧ f = 0" using continuity_lem_eq0[of "k" "y'" d e f]
      by auto
  qed
  then have eqprop: "∀x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) "
    by auto
  have lesprop: "(∃y'>k. (∀(d, e, f)∈set b. ∀x∈{k<..y'}. d * x2 + e * x + f < 0))" 
    using les_qe_inf_helper[of b "k"] asm 
    by blast 
  have leqprop: "(∃y'>k. (∀(d, e, f)∈set c. ∀x∈{(k)<..y'}. d * x2 + e * x + f ≤ 0))" 
    using leq_qe_inf_helper[of c "k"] asm 
    by blast 
  have neqprop: "(∃y'>(k). (∀(d, e, f)∈set d. ∀x∈{(k)<..y'}. d * x2 + e * x + f ≠ 0))" 
    using neq_qe_inf_helper[of d "k"] asm 
    by blast  
  then have "(∃x. (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)) " 
    using lesprop leqprop neqprop min_lem[of "k" b c d]
    by auto
  then show ?thesis
    using eqprop by auto 
qed

subsubsection "The qe\\_backwards lemma"
lemma qe_backwards: 
  assumes "(((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) 
     ∨
     (∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)        
          ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))) 
    ∨
     (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) 
    ∨
     (∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))) 
      ∨
     (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))))"
  shows " (∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))" 
proof - 
  let ?e2 = "(((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) 
     ∨
     (∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)         
          ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))) 
    ∨
     (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) 
    ∨
     (∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))) 
      ∨
     (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))))"
  let ?f10orf11orf12 = "(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f8orf9 = "(∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  let ?f5orf6orf7 = "(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) 
      ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f2orf3orf4 = "(∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) 
        ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)         
          ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  let ?e1 = "(∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
  let ?f1 = "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0))"
  let ?f2 = "(∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
  let ?f3 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'2 + 4 * a' * c' ≤ 0 ∧
         (∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))"
  let ?f4 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'2 + 4 * a' * c' ≤ 0 ∧
 (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)) "
  let ?f5 = "(∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  let ?f6 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f7 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  let ?f8 = "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0))"
  let ?f13 = "(∃(a', b', c')∈set c.
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0)))"
  let ?f9 = "(∃(a', b', c')∈set c.  a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
        (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f = 0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠ 0))"
  let ?f10 = "(∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0))"
  let ?f11 = "(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"
  let ?f12 = "(∃(a', b', c')∈set d.
          a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))"
  have h1a: "?e2 ⟶ (?f1 ∨ ?f2orf3orf4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12)"
    by auto
  have h2: "?f2orf3orf4 ⟶ (?f2 ∨ ?f3 ∨ ?f4)" by auto
  then have h1b: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12) "
    using h1a by auto
  have h3: "?f5orf6orf7 ⟶ (?f5 ∨ ?f6 ∨ ?f7)" by auto
  then have h1c: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8orf9 ∨ ?f10orf11orf12) "
    using h1b by smt 
  have h4: "?f8orf9 ⟶ (?f8 ∨ ?f9 ∨ ?f13)" by auto
  then have h1d: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f9 ∨ ?f13 ∨ ?f10orf11orf12) "
    using h1c
    by smt 
  have h5: "?f10orf11orf12 ⟶ (?f10 ∨ ?f11 ∨ ?f12)" 
    by auto
  then have bigor: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12) "
    using h1d  by smt 
  have "?f1 ⟹ ?e1"
  proof - 
    assume asm: "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
    (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
    (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
    (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0)"
    then have eqprop: "∀x. ∀(a, b, c)∈set a. a * x2 + b * x + c = 0" by auto
    have "∃y. ∀x<y. ∀(a, b, c)∈set b. a * x2 + b * x + c < 0"
      using asm h1b_helper_les by auto
    then obtain y1 where y1_prop: "∀x<y1. ∀(a, b, c)∈set b. a * x2 + b * x + c < 0" by auto
    have "∃y. ∀x<y. ∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0"
      using asm h1b_helper_leq by auto
    then obtain y2 where y2_prop: "∀x<y2. ∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0" by auto
    have "∃y. ∀x<y. ∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0"
      using asm h1b_helper_neq by auto
    then obtain y3 where y3_prop: "∀x<y3. ∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0" by auto
    let ?y = "(min (min y1 y2) y3) - 1"
    have y_prop: "?y < y1 ∧ ?y < y2 ∧ ?y < y3"
      by auto
    have ap: "(∀(a, b, c)∈set a. a * ?y2 + b * ?y + c = 0)" 
      using eqprop by auto
    have bp: "(∀(a, b, c)∈set b. a * ?y2 + b * ?y + c < 0)"  
      using y_prop y1_prop by auto 
    have cp: "(∀(a, b, c)∈set c. a * ?y2 + b * ?y + c ≤ 0)"  
      using y_prop y2_prop by auto 
    have dp: "(∀(a, b, c)∈set d. a * ?y2 + b * ?y + c ≠ 0)"  
      using y_prop y3_prop by auto 
    then have  "(∀(a, b, c)∈set a. a * ?y2 + b * ?y + c = 0) ∧
        (∀(a, b, c)∈set b. a * ?y2 + b * ?y + c < 0) ∧
        (∀(a, b, c)∈set c. a * ?y2 + b * ?y + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * ?y2 + b * ?y + c ≠ 0)"
      using ap bp cp dp by auto
    then show ?thesis by auto
  qed
  then have h1: "?f1 ⟶ ?e1" 
    by auto
  have "?f2 ⟹ ?e1" 
  proof - 
    assume " ∃(a', b', c')∈set a.
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
       (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
       (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
       (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set a ∧
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
       (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
       (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
       (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)"
      by auto
    then have "∃(x::real). x = -c'/b'" by auto
    then obtain x where x_prop: "x = - c' / b'" by auto
    then have "(∀xa∈set a. case xa of (a, b, c) ⇒ a * x2 + b * x + c = 0) ∧
        (∀xa∈set b. case xa of (a, b, c) ⇒ a * x2 + b * x + c < 0) ∧
        (∀xa∈set c. case xa of (a, b, c) ⇒ a * x2 + b * x + c ≤ 0) ∧
        (∀xa∈set d. case xa of (a, b, c) ⇒ a * x2 + b * x + c ≠ 0)"
      using abc_prop by auto
    then show ?thesis by auto
  qed
  then have h2: "?f2 ⟶ ?e1" 
    by auto
  have "?f3 ⟹ ?e1" 
  proof -
    assume "∃(a', b', c')∈set a.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f = 0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f  ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set a ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f = 0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f  ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)" by auto
    then have "∃(x::real). x = (- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then obtain x where x_prop: " x = (- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then have "(∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
        (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
        (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" using abc_prop by auto
    then show ?thesis by auto
  qed
  then have h3: "?f3  ⟶ ?e1" 
    by auto
  have "?f4 ⟹ ?e1" 
  proof -
    assume " ∃(a', b', c')∈set a.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f = 0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set a ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f = 0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)" by auto
    then have "∃(x::real). x = (- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then obtain x where x_prop: " x = (- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then have "(∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
        (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
        (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" using abc_prop by auto
    then show ?thesis by auto
  qed
  then have "?f4 ⟶ ?e1" by auto
  have "?f5 ⟹ ?e1" 
  proof - 
    assume asm: "∃(a', b', c')∈set b.
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set b ∧
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)"
      by auto
    then show ?thesis using qe_infinitesimals_helper[of a "- c' / b'" b c d]
      by auto
  qed
  then have h5: "?f5 ⟶ ?e1" 
    by auto
  have "?f6 ⟹ ?e1" 
  proof - 
    assume "∃(a', b', c')∈set b.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set b ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)" by auto
    then show ?thesis using qe_infinitesimals_helper[of a "(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" b c d]
      by auto
  qed
  then have h6: "?f6  ⟶ ?e1" 
    by auto
  have "?f7 ⟹ ?e1" 
  proof - 
    assume "∃(a', b', c')∈set b.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set b ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)"
      by auto
    then show ?thesis using qe_infinitesimals_helper[of a "(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" b c d]
      by auto
  qed
  then have h7: "?f7 ⟶ ?e1"
    by auto
  have "?f8 ⟹ ?e1"   
  proof -
    assume "∃(a', b', c')∈set c.
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
       (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
       (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
       (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
       (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
       (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
       (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0)" by auto
    then have "∃(x::real). x = (- c' / b')" by auto
    then obtain x where x_prop: " x = - c' / b'" by auto
    then have "(∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
        (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
        (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" using abc_prop by auto
    then show ?thesis by auto
  qed
  then have h8: "?f8 ⟶ ?e1" by auto
  have "?f9 ⟹ ?e1" 
  proof -
    assume "∃(a', b', c')∈set c.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f =  0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f =  0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f  < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠  0)" by auto
    then have "∃(x::real). x = (- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then obtain x where x_prop: " x = (- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then have "(∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
        (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
        (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" using abc_prop by auto
    then show ?thesis by auto
  qed
  then have h9:  "?f9 ⟶ ?e1" by auto
  have "?f10 ⟹ ?e1"
  proof - 
    assume asm: "∃(a', b', c')∈set d.
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set d ∧
       (a' = 0 ∧ b' ≠ 0) ∧
       (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0)"
      by auto
    then show ?thesis using qe_infinitesimals_helper[of a "- c' / b'" b c d]
      by auto
  qed
  then have h10: "?f10 ⟶ ?e1" by auto
  have "?f11 ⟹ ?e1"   
  proof - 
    assume "∃(a', b', c')∈set d.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set d ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)" by auto
    then show ?thesis using qe_infinitesimals_helper[of a "(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" b c d]
      by auto
  qed
  then have h11: "?f11 ⟶ ?e1" by auto
  have "?f12 ⟹ ?e1"  proof - 
    assume "∃(a', b', c')∈set d.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set d ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f = 0) ∧
       (∀(d, e, f)∈set b.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f < 0) ∧
       (∀(d, e, f)∈set c.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
              ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                 d * x2 + e * x + f ≠ 0)"
      by auto
    then show ?thesis using qe_infinitesimals_helper[of a "(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" b c d]
      by auto
  qed
  then have h12: "?f12 ⟶ ?e1" by auto
  have "?f13 ⟹ ?e1" proof -
    assume " ∃(a', b', c')∈set c.
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f = 0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)"
    then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧
       a' ≠ 0 ∧
       - b'2 + 4 * a' * c' ≤ 0 ∧
       (∀(d, e, f)∈set a.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f = 0) ∧
       (∀(d, e, f)∈set b.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f < 0) ∧
       (∀(d, e, f)∈set c.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≤ 0) ∧
       (∀(d, e, f)∈set d.
           d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
           e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
           f ≠ 0)" by auto
    then have "∃(x::real). x = (- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then obtain x where x_prop: " x = (- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')" by auto
    then have "(∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
        (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
        (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
        (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)" using abc_prop by auto
    then show ?thesis by auto
  qed
  then have h13: "?f13 ⟶ ?e1" by auto
  show ?thesis using bigor h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 h11 h12 h13
    using assms
    by (smt ‹∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 + e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 + e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 + e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 + e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ⟹ ∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)›) 
      (* by force *)
qed

subsection "General QE lemmas"

lemma qe: "(∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0)) =
    ((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) ∨
     (∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0) ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0))) ∨
     (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) ∨
     (∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0) ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0))) ∨
     (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))))" 
proof - 
  let ?e1 = "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧
     (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y2 + b * y + c < 0) ∧
     (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ∧
     (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y2 + b * y + c ≠ 0) ∨
     (∃(a', b', c')∈set a.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0) ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0))) ∨
     (∃(a', b', c')∈set b.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))) ∨
     (∃(a', b', c')∈set c.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
         (∀(d, e, f)∈set b. d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
         (∀(d, e, f)∈set c. d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
         (∀(d, e, f)∈set d. d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0) ∨
          (∀(d, e, f)∈set a.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f =
              0) ∧
          (∀(d, e, f)∈set b.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              < 0) ∧
          (∀(d, e, f)∈set c.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f
              ≤ 0) ∧
          (∀(d, e, f)∈set d.
              d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
              e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
              f ≠
              0))) ∨
     (∃(a', b', c')∈set d.
         (a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set b.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set c.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set d.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set a.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set b.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set c.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set d.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0))))" 
  let ?e2 = "(∃x. (∀(a, b, c)∈set a. a * x2 + b * x + c = 0) ∧
         (∀(a, b, c)∈set b. a * x2 + b * x + c < 0) ∧
         (∀(a, b, c)∈set c. a * x2 + b * x + c ≤ 0) ∧
         (∀(a, b, c)∈set d. a * x2 + b * x + c ≠ 0))"
  have h1: "?e1 ⟶ ?e2" using qe_backwards 
    by auto
  have h2: "?e2 ⟶ ?e1" using qe_forwards
    by auto
  have "(?e2 ⟶ ?e1) ∧ (?e1 ⟶ ?e2) " using h1 h2
    by force 
  then have  "?e2 ⟷ ?e1"
    using iff_conv_conj_imp[of ?e1 ?e2]
    by presburger
  then show ?thesis
    by auto
qed


fun eq_fun :: "real ⇒ real ⇒ real ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ bool" where
  "eq_fun a' b' c' eq les leq neq = ((a' = 0 ∧ b' ≠ 0) ∧
          (∀a∈set eq.
              case a of (d, e, f) ⇒ d * (- c' / b')2 + e * (- c' / b') + f = 0) ∧
          (∀a∈set les.
              case a of (d, e, f) ⇒ d * (- c' / b')2 + e * (- c' / b') + f < 0) ∧
          (∀a∈set leq.
              case a of (d, e, f) ⇒ d * (- c' / b')2 + e * (- c' / b') + f ≤ 0) ∧
          (∀a∈set neq.
              case a of (d, e, f) ⇒ d * (- c' / b')2 + e * (- c' / b') + f ≠ 0) ∨
          a' ≠ 0 ∧
          - b'2 + 4 * a' * c' ≤ 0 ∧
          ((∀a∈set eq.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f =
                 0) ∧
           (∀a∈set les.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f
                 < 0) ∧
           (∀a∈set leq.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f
                 ≤ 0) ∧
           (∀a∈set neq.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f ≠
                 0) ∨
           (∀a∈set eq.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f =
                 0) ∧
           (∀a∈set les.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f
                 < 0) ∧
           (∀a∈set leq.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f
                 ≤ 0) ∧
           (∀a∈set neq.
               case a of
               (d, e, f) ⇒
                 d * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a'))2 +
                 e * ((- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')) +
                 f ≠
                 0)))"

fun les_fun :: "real ⇒ real ⇒ real ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ bool" where 
  "les_fun a' b' c' eq les leq neq = ((a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set eq.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f = 0) ∧
         (∀(d, e, f)∈set les.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f < 0) ∧
         (∀(d, e, f)∈set leq.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≤ 0) ∧
         (∀(d, e, f)∈set neq.
             ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x2 + e * x + f ≠ 0) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set eq.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set les.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set leq.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set neq.
              ∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0) ∨
          (∀(d, e, f)∈set eq.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f = 0) ∧
          (∀(d, e, f)∈set les.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f < 0) ∧
          (∀(d, e, f)∈set leq.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≤ 0) ∧
          (∀(d, e, f)∈set neq.
              ∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
                 ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
                    d * x2 + e * x + f ≠ 0)))"

lemma general_qe' :
  (* Direct substitution F(x) *)
  assumes "F = (λx. 
               (∀(a,b,c)∈set eq . a*x2+b*x+c=0)∧
               (∀(a,b,c)∈set les. a*x2+b*x+c<0)∧
               (∀(a,b,c)∈set leq. a*x2+b*x+c≤0)∧
               (∀(a,b,c)∈set neq. a*x2+b*x+c≠0))"
    (* Substitution of r+ε into F *)
  assumes "Fε = (λr. 
         (∀(a,b,c)∈set eq.  ∃y>r.∀x∈{r<..y}. a*x2+b*x+c=0) ∧
         (∀(a,b,c)∈set les. ∃y>r.∀x∈{r<..y}. a*x2+b*x+c<0) ∧
         (∀(a,b,c)∈set leq. ∃y>r.∀x∈{r<..y}. a*x2+b*x+c≤0) ∧
         (∀(a,b,c)∈set neq. ∃y>r.∀x∈{r<..y}. a*x2+b*x+c≠0)
        )"
    (* Substitution of -∞ into F *)
  assumes "Finf = (
     (∀(a,b,c)∈set eq.  ∃x. ∀y<x. a*y2+b*y+c=0) ∧
     (∀(a,b,c)∈set les. ∃x. ∀y<x. a*y2+b*y+c<0) ∧
     (∀(a,b,c)∈set leq. ∃x. ∀y<x. a*y2+b*y+c≤0) ∧
     (∀(a,b,c)∈set neq. ∃x. ∀y<x. a*y2+b*y+c≠0)
    )"
    (* finds linear or quadratic roots of a polynomial *)
  assumes "roots = (λ(a,b,c).
     if a=0 ∧ b≠0 then {-c/b}::real set else
     if a≠0 ∧ b2-4*a*c≥0 then {(-b+sqrt(b2-4*a*c))/(2*a)}∪{(-b-sqrt(b2-4*a*c))/(2*a)} else {})"
    (* all the root of each atom *)
  assumes "A = ⋃(roots ` (set eq))"
  assumes "B = ⋃(roots ` (set les))"
  assumes "C = ⋃(roots ` (set leq))"
  assumes "D = ⋃(roots ` (set neq))"
    (* Quantifier Elimination *)
  shows "(∃x. F(x)) = (Finf∨(∃r∈A. F r)∨(∃r∈B. Fε r)∨(∃r∈C. F r)∨(∃r∈D. Fε r))"
proof-
  { fix X
    have "(∃(a, b, c)∈set X. eq_fun a b c eq les leq neq) = (∃x∈F ` ⋃(roots ` (set X)). x)"
    proof(induction X)
      case Nil
      then show ?case by auto
    next
      case (Cons p X)
      have h1: "(∃x∈F ` ⋃ (roots ` set (p # X)). x) = ((∃x∈F ` roots p. x) ∨ (∃x∈F ` ⋃ (roots ` set X). x))"
        by auto
      have h2 :"(case p of (a,b,c) ⇒ eq_fun a b c eq les leq neq) = (∃x∈F ` roots p. x)"
        apply(cases p) unfolding assms apply simp by linarith
      show ?case  unfolding h1 Cons[symmetric] using h2 by auto
    qed
  }
  then have eq : "⋀X. (∃(a, b, c)∈set X. eq_fun a b c eq les leq neq) = (∃x∈F ` ⋃ (roots ` set X). x)" by auto
  { fix X
    have "(∃(a, b, c)∈set X. les_fun a b c eq les leq neq) = (∃x∈Fε ` ⋃(roots ` (set X)). x)"
    proof(induction X)
      case Nil
      then show ?case by auto
    next
      case (Cons p X)
      have h1: "(∃x∈Fε ` ⋃ (roots ` set (p # X)). x) = ((∃x∈Fε ` roots p. x) ∨ (∃x∈Fε ` ⋃ (roots ` set X). x))"
        by auto
      have h2 :"(case p of (a,b,c) ⇒ les_fun a b c eq les leq neq) = (∃x∈Fε ` roots p. x)"
        apply(cases p) unfolding assms apply simp by linarith
      show ?case  unfolding h1 Cons[symmetric] using h2 by auto
    qed
  }
  then have les : "⋀X. (∃(a, b, c)∈set X. les_fun a b c eq les leq neq) = (∃x∈Fε ` ⋃ (roots ` set X). x)" by auto
  have inf : "(∀(a, b, c)∈set eq. a = 0 ∧ b = 0 ∧ c = 0) = (∀x∈set eq. case x of (a, b, c) ⇒ ∃x. ∀y<x. a * y2 + b * y + c = 0)"
  proof(induction eq)
    case Nil
    then show ?case by auto
  next
    case (Cons p eq)
    then show ?case proof(cases p)
      case (fields a b c)
      show ?thesis unfolding fields using infzeros[of _ a b c] Cons by auto
    qed
  qed
  show ?thesis
    using qe[of "eq" "les" "leq" "neq"]
    using eq[of eq] eq[of leq] les[of les] les[of neq] unfolding inf assms
    by auto
qed

lemma general_qe'' :
  (* Direct substitution F(x) *)
  assumes "S = {(=), (<), (≤), (≠)}"
  assumes "finite (X (=))"
  assumes "finite (X (<))"
  assumes "finite (X (≤))"
  assumes "finite (X (≠))"
  assumes "F = (λx. ∀rel∈S. ∀(a,b,c)∈(X rel). rel (a*x2+b*x+c) 0)"
    (* Substitution of r+ε into F *)
  assumes "Fε = (λr. ∀rel∈S. ∀(a,b,c)∈(X rel). ∃y>r.∀x∈{r<..y}. rel (a*x2+b*x+c) 0)"
    (* Substitution of -∞ into F *)
  assumes "Finf = (∀rel∈S. ∀(a,b,c)∈(X rel). ∃x. ∀y<x. rel (a*y2+b*y+c) 0)"
    (* finds linear or quadratic roots of a polynomial *)
  assumes "roots = (λ(a,b,c).
     if a=0 ∧ b≠0 then {-c/b}::real set else
     if a≠0 ∧ b2-4*a*c≥0 then {(-b+sqrt(b2-4*a*c))/(2*a)}∪{(-b-sqrt(b2-4*a*c))/(2*a)} else {})"
    (* all the root of each atom *)
  assumes "A = ⋃(roots ` ((X (=))))"
  assumes "B = ⋃(roots ` ((X (<))))"
  assumes "C = ⋃(roots ` ((X (≤))))"
  assumes "D = ⋃(roots ` ((X (≠))))"
    (* Quantifier Elimination *)
  shows "(∃x. F(x)) = (Finf∨(∃r∈A. F r)∨(∃r∈B. Fε r)∨(∃r∈C. F r)∨(∃r∈D. Fε r))"
proof-
  define less where "less = (λ(a::real,b::real,c::real).λ(a',b',c'). a<a'∨ (a=a'∧ (b<b'∨(b=b'∧c<c'))))"
  define leq where "leq = (λx.λy. x=y ∨ less x y)"
  have linorder: "class.linorder leq less"
    unfolding class.linorder_def class.order_def class.preorder_def class.order_axioms_def class.linorder_axioms_def
      less_def leq_def by auto
  show ?thesis
    using assms(6-8) unfolding assms(1) apply simp
    using general_qe'[OF _ _ _ assms(9), of F "List.linorder.sorted_list_of_set leq (X (=))" "List.linorder.sorted_list_of_set leq (X (<))" "List.linorder.sorted_list_of_set leq (X (≤))" "List.linorder.sorted_list_of_set leq (X (≠))" Fε Finf A B C D]
    unfolding List.linorder.set_sorted_list_of_set[OF linorder assms(2)] List.linorder.set_sorted_list_of_set[OF linorder assms(3)] List.linorder.set_sorted_list_of_set[OF linorder assms(4)] List.linorder.set_sorted_list_of_set[OF linorder assms(5)]
    using assms(10-13)by auto
qed


theorem general_qe :
  (* finite sets of atoms involving = < ≤ and ≠*)
  assumes "R = {(=), (<), (≤), (≠)}"
  assumes "∀rel∈R. finite (Atoms rel)"
    (* Direct substitution F(x) *)
  assumes "F = (λx. ∀rel∈R. ∀(a,b,c)∈(Atoms rel). rel (a*x2+b*x+c) 0)"
    (* Substitution of r+ε into F *)
  assumes "Fε = (λr. ∀rel∈R. ∀(a,b,c)∈(Atoms rel). ∃y>r.∀x∈{r<..y}. rel (a*x2+b*x+c) 0)"
    (* Substitution of -∞ into F *)
  assumes "Finf = (∀rel∈R. ∀(a,b,c)∈(Atoms rel). ∃x. ∀y<x. rel (a*y2+b*y+c) 0)"
    (* finds linear or quadratic roots of a polynomial *)
  assumes "roots = (λ(a,b,c).
     if a=0 ∧ b≠0 then {-c/b} else
     if a≠0 ∧ b2-4*a*c≥0 then {(-b+sqrt(b2-4*a*c))/(2*a)}∪{(-b-sqrt(b2-4*a*c))/(2*a)} else {})"
    (* Quantifier Elimination *)
  shows "(∃x. F(x)) = 
            (Finf ∨
            (∃r∈⋃(roots ` (Atoms (=) ∪ Atoms (≤))). F r) ∨
            (∃r∈⋃(roots ` (Atoms (<) ∪ Atoms (≠))). Fε r))"
  using general_qe''[OF assms(1) _ _ _ _ assms(3-6) refl refl refl refl]
  using assms(2) unfolding assms(1) 
  by auto

end

Theory MPolyExtension

section "Multivariate Polynomials Extension"
theory MPolyExtension
  imports Polynomials.Polynomials (*MPoly_Type_Efficient_Code*) Polynomials.MPoly_Type_Class_FMap
begin

subsection "Definition Lifting"

lift_definition coeff_code::"'a::zero mpoly ⇒ (nat ⇒0 nat) ⇒ 'a" is
  "lookup" .

lemma coeff_code[code]: "coeff = coeff_code"
  unfolding coeff_def apply(transfer) by auto

lemma coeff_transfer[transfer_rule]:― ‹TODO: coeff should be defined via
lifting, this gives us the illusion›
  "rel_fun cr_mpoly (=) lookup coeff" using coeff_code.transfer[folded
      coeff_code] .

lemmas coeff_add = coeff_add[symmetric]

lemma plus_monom_zero[simp]: "p + MPoly_Type.monom m 0 = p"
  by transfer auto

lift_definition monomials::"'a::zero mpoly ⇒ (nat ⇒0 nat) set" is
  "Poly_Mapping.keys::((nat⇒0nat) ⇒0 'a) ⇒ _ set" .

lemma mpoly_induct [case_names monom sum]:― ‹TODO: overwrites @{thm
mpoly_induct}›
  assumes monom:"⋀m a. P (MPoly_Type.monom m a)"
    and sum:"(⋀p1 p2 m a. P p1 ⟹ P p2 ⟹ p2 = (MPoly_Type.monom m a) ⟹ m ∉ monomials p1
⟹ a ≠ 0 ⟹ P (p1+p2))"
  shows "P p" using assms
proof (induction p rule: mpoly_induct)
  case (sum p1 p2 m a)
  then show ?case
    by (cases "a = 0") (auto simp: monomials.rep_eq)
qed simp

value "monomials ((Var 0 + Const (3::int) * Var 1)^2)"

lemma Sum_any_lookup_times_eq:
  "(∑k. ((lookup (x::'a⇒0('b::comm_semiring_1)) (k::'a)) * ((f:: 'a⇒('b::comm_semiring_1)) k))) = (∑k∈keys
x. (lookup x (k::'a)) * (f k))"
  by (subst Sum_any.conditionalize) (auto simp: in_keys_iff intro!:
      Sum_any.cong)

lemma Prod_any_power_lookup_eq:
  "(∏k::'a. f k ^ lookup (x::'a⇒0nat) k) = (∏k∈keys x. f k ^ lookup x k)"
  by (subst Prod_any.conditionalize) (auto simp: in_keys_iff intro!:
      Prod_any.cong)

lemma insertion_monom: "insertion i (monom m a) = a * (∏k∈keys m. i k ^
lookup m k)"
  by transfer (auto simp: insertion_aux_def insertion_fun_def
      Sum_any_lookup_times_eq Prod_any_power_lookup_eq)

lemma monomials_monom[simp]: "monomials (monom m a) = (if a = 0 then {}
else {m})"
  by transfer auto

lemma finite_monomials[simp]: "finite (monomials m)"
  by transfer auto

lemma monomials_add_disjoint:
  "monomials (a + b) = monomials a ∪ monomials b" if "monomials a ∩
monomials b = {}"
  using that
  by transfer (auto simp add: keys_plus_eqI)

lemma coeff_monom[simp]: "coeff (monom m a) m = a"
  by transfer simp

lemma coeff_not_in_monomials[simp]: "coeff m x = 0" if "x ∉ monomials m"
  using that
  by transfer (simp add: in_keys_iff)

code_thms insertion

lemma insertion_code[code]: "insertion i mp =
   (∑m∈monomials mp. (coeff mp m) * (∏k∈keys m. i k ^ lookup m k))"
proof (induction mp rule: mpoly_induct)
  case (monom m a)
  show ?case
    by (simp add: insertion_monom)
next
  case (sum p1 p2 m a)
  have monomials_add: "monomials (p1 + p2) = insert m (monomials p1)"
    using sum.hyps
    by (auto simp: monomials_add_disjoint)
  have *: "coeff (monom m a) x = 0" if "x ∈ monomials p1" for x
    using sum.hyps that
    by (subst coeff_not_in_monomials) auto
  show ?case
    unfolding insertion_add monomials_add sum.IH
    using sum.hyps
    by (auto simp: coeff_add * algebra_simps)
qed


(* insertion f p
  takes in a mapping from natural numbers to the type of the polynomial and substitutes in
  the constant (f var) for each var variable in polynomial p
*)
code_thms insertion

value "insertion (nth [1, 2.3]) ((Var 0 + Const (3::int) * Var 1)^2)"


(* isolate_variable_sparse p var degree
    returns the coefficient of the term a*var^degree in polynomial p
 *)
lift_definition isolate_variable_sparse::"'a::comm_monoid_add mpoly ⇒
nat ⇒ nat ⇒ 'a mpoly" is
  "λ(mp::'a mpoly) x d. sum
     (λm. monomial (coeff mp m) (Poly_Mapping.update x 0 m))
     {m ∈ monomials mp. lookup m x = d}" .

lemma Poly_Mapping_update_code[code]: "Poly_Mapping.update a b (Pm_fmap
fm) = Pm_fmap (fmupd a b fm)"
  by (auto intro!: poly_mapping_eqI simp: update.rep_eq
      fmlookup_default_def)


lemma monom_zero [simp] : "monom m 0 = 0"
  by (simp add: coeff_all_0)


lemma remove_key_code[code]: "remove_key v (Pm_fmap fm) = Pm_fmap
(fmdrop v fm)"
  by (auto simp: remove_key_lookup fmlookup_default_def intro!:
      poly_mapping_eqI)
lemma extract_var_code[code]:
  "extract_var p v =
     (∑m∈monomials p. monom (remove_key v m) (monom (Poly_Mapping.single
v (lookup m v)) (coeff p m)))"
  apply (rule extract_var_finite_set[where S="monomials p"])
  using coeff_not_in_monomials by auto
value "extract_var ((Var 0 + Const (3::real) * Var 1)^2) 0"



(* degree p var
  takes in polynomial p and a variable var and finds the degree of that variable in the polynomial
  missing code theorems? still manages to evaluate
*)
code_thms degree
value "degree ((Var 0 + Const (3::real) * Var 1)^2) 0"


(* this function gives a set of all the variables in the polynomial
*)
lemma vars_code[code]: "vars p = ⋃ (keys ` monomials p)"
  unfolding monomials.rep_eq vars_def ..

value "vars ((Var 0 + Const (3::real) * Var 1)^2)"


(* return true if the polynomial contains no variables
*)
fun is_constant :: "'a::zero mpoly ⇒ bool" where
  "is_constant p = Set.is_empty (vars p)"

value "is_constant (Const (0::int))"


(*
  if the polynomial is constant, returns the real value associated with the polynomial,
  otherwise returns none
*)
fun get_if_const :: "real mpoly ⇒ real option" where
  "get_if_const p = (if is_constant p then Some (coeff p 0) else None)"

term "coeff p 0"


lemma insertionNegative : "insertion f p = - insertion f (-p)"
  by (metis (no_types, hide_lams) add_eq_0_iff cancel_comm_monoid_add_class.diff_cancel insertion_add insertion_zero uminus_add_conv_diff)  


definition derivative :: "nat ⇒ real mpoly ⇒ real mpoly" where
  "derivative x p = (∑i∈{0..degree p x-1}. isolate_variable_sparse p x (i+1) * (Var x)^i * (Const (i+1)))"

text "get\\_coeffs $x$ $p$
  gets the tuple of coefficients $a$ $b$ $c$ of the term $a*x^2+b*x+c$ in polynomial $p$"
fun get_coeffs :: "nat ⇒ real mpoly ⇒ real mpoly * real mpoly * real mpoly" where
  "get_coeffs var x = (
  isolate_variable_sparse x var 2,
  isolate_variable_sparse x var 1,
  isolate_variable_sparse x var 0)
"

end

Theory ExecutiblePolyProps

text "Executable Polynomial Properties"
theory ExecutiblePolyProps
  imports
    Polynomials.MPoly_Type_Univariate
    MPolyExtension
begin

text ‹(Univariate) Polynomial hiding›

lifting_update poly.lifting
lifting_forget poly.lifting

text ‹›

no_notation MPoly_Type.div (infixl "div" 70)
no_notation MPoly_Type.mod (infixl "mod" 70)

subsection "Lemmas with Monomial and Monomials"

lemma of_nat_monomial: "of_nat p = monomial p 0"
  by (auto simp: poly_mapping_eq_iff lookup_of_nat fun_eq_iff lookup_single)

lemma of_nat_times_monomial: "of_nat p * monomial c i = monomial (p*c) i"
  by (auto simp: poly_mapping_eq_iff prod_fun_def fun_eq_iff of_nat_monomial
      lookup_single mult_single)

lemma monomial_adds_nat_iff: "monomial p i adds c ⟷ lookup c i ≥ p" for p::"nat"
  apply (auto simp: adds_def lookup_add)
  by (metis add.left_commute nat_le_iff_add remove_key_sum single_add)

lemma update_minus_monomial: "Poly_Mapping.update k i (m - monomial i k) = Poly_Mapping.update k i m"
  by (auto simp: poly_mapping_eq_iff lookup_update update.rep_eq fun_eq_iff lookup_minus
      lookup_single)

lemma monomials_Var: "monomials (Var x::'a::zero_neq_one mpoly) = {Poly_Mapping.single x 1}"
  by transfer (auto simp: Var0_def)

lemma monomials_Const: "monomials (Const x) = (if x = 0 then {} else {0})"
  by transfer' (auto simp: Const0_def)

lemma coeff_eq_zero_iff: "MPoly_Type.coeff c p = 0 ⟷ p ∉ monomials c"
  by transfer (simp add: not_in_keys_iff_lookup_eq_zero)

lemma monomials_1[simp]: "monomials 1 = {0}"
  by transfer auto

lemma monomials_and_monoms: 
  shows "(k ∈ monomials m) = (∃ (a::nat). a ≠ 0 ∧ (monomials (MPoly_Type.monom k a)) ⊆ monomials m)"
proof - 
  show ?thesis using monomials_monom by auto
qed

lemma mult_monomials_dir_one:
  shows "monomials (p*q) ⊆ {a+b | a b . a ∈ monomials p ∧ b ∈ monomials q}"
  using monomials_and_monoms mult_monom
  by (simp add: keys_mult monomials.rep_eq times_mpoly.rep_eq) 

lemma monom_eq_zero_iff[simp]: "MPoly_Type.monom a b = 0 ⟷ b = 0"
  by (metis MPolyExtension.coeff_monom MPolyExtension.monom_zero)

lemma update_eq_plus_monomial:
  "v ≥ lookup m k ⟹ Poly_Mapping.update k v m = m + monomial (v - lookup m k) k"
  for v n::nat
  by transfer auto

lemma coeff_monom_mult':
  "MPoly_Type.coeff ((MPoly_Type.monom m' a) * q) (m'm)  = a * MPoly_Type.coeff q (m'm - m')"
  if *: "m'm = m' + (m'm - m')"
  by (subst *) (rule More_MPoly_Type.coeff_monom_mult)

lemma monomials_zero[simp]: "monomials 0 = {}"
  by transfer auto

lemma in_monomials_iff: "x ∈ monomials m ⟷ MPoly_Type.coeff m x ≠ 0"
  using coeff_eq_zero_iff[of m x] by auto

lemma monomials_monom_mult: "monomials (MPoly_Type.monom mon a * q) = (if a = 0 then {} else (+) mon ` monomials q)"
  for q::"'a::semiring_no_zero_divisors mpoly"
  apply auto
  subgoal by transfer' (auto elim!: in_keys_timesE)
  subgoal by (simp add: in_monomials_iff More_MPoly_Type.coeff_monom_mult)
  done

subsection "Simplification Lemmas for Const 0 and Const 1"
lemma add_zero : "P + Const 0 = P"
proof -
  have h:"P + 0 = P" using add_0_right by auto
  show ?thesis unfolding Const_def using h by (simp add: Const0_zero zero_mpoly.abs_eq)
qed

(* example *)
lemma add_zero_example : "((Var 0)^2 - (Const 1)) + Const 0 = ((Var 0)^2 - (Const 1))"
proof -
  show ?thesis by (simp add : add_zero)
qed

lemma mult_zero_left : "Const 0 * P = Const 0"
proof -
  have h:"0*P = 0" by simp
  show ?thesis unfolding Const_def using h by (simp add: Const0_zero zero_mpoly_def)
qed

lemma mult_zero_right : "P * Const 0 = Const 0"
  by (metis mult_zero_left mult_zero_right)

lemma mult_one_left : "Const 1 * (P :: real mpoly) = P"
  by (simp add: Const.abs_eq Const0_one one_mpoly_def)

lemma mult_one_right : "(P::real mpoly) * Const 1 = P"
  by (simp add: Const.abs_eq Const0_one one_mpoly_def)


subsection "Coefficient Lemmas"
lemma coeff_zero[simp]: "MPoly_Type.coeff 0 x = 0"
  by transfer auto

lemma coeff_sum: "MPoly_Type.coeff (sum f S) x = sum (λi. MPoly_Type.coeff (f i) x) S"
  apply (induction S rule: infinite_finite_induct) 
    apply (auto)
  by (metis More_MPoly_Type.coeff_add)

lemma coeff_mult_Var: "MPoly_Type.coeff (x * Var i ^ p) c = (MPoly_Type.coeff x (c - monomial p i) when lookup c i ≥ p)"
  by transfer'
    (auto simp: Var0_def pprod.monomial_power lookup_times_monomial_right
      of_nat_times_monomial monomial_adds_nat_iff)

lemma lookup_update_self[simp]: "Poly_Mapping.update i (lookup m i) m = m"
  by (auto simp: lookup_update intro!: poly_mapping_eqI)

lemma coeff_Const: "MPoly_Type.coeff (Const p) m = (p when m = 0)"
  by transfer' (auto simp: Const0_def lookup_single)

lemma coeff_Var: "MPoly_Type.coeff (Var p) m = (1 when m = monomial 1 p)"
  by transfer' (auto simp: Var0_def lookup_single when_def)

subsection "Miscellaneous"
lemma update_0_0[simp]: "Poly_Mapping.update x 0 0 = 0"
  by (metis lookup_update_self lookup_zero)

lemma mpoly_eq_iff: "p = q ⟷ (∀m. MPoly_Type.coeff p m = MPoly_Type.coeff q m)"
  by transfer (auto simp: poly_mapping_eqI)

lemma power_both_sides :
  assumes Ah : "(A::real) ≥0"
  assumes Bh : "(B::real) ≥0"
  shows "(A≤B) = (A^2≤B^2)"
  using Ah Bh by (meson power2_le_imp_le power_mono)

lemma in_list_induct_helper: 
  assumes "set(xs)⊆X"
  assumes  "P []"
  assumes "(⋀x. x∈X ⟹ ( ⋀xs. P xs ⟹ P (x # xs)))"
  shows "P xs" using assms(1)
proof(induction xs)
  case Nil
  then show ?case using assms by auto
next
  case (Cons a xs)
  then show ?case using assms(3) by auto
qed

theorem in_list_induct [case_names Nil Cons]: 
  assumes  "P []"
  assumes "(⋀x. x∈set(xs) ⟹ ( ⋀xs. P xs ⟹ P (x # xs)))"
  shows "P xs"
  using in_list_induct_helper[of xs "set(xs)" P] using assms by auto

subsubsection "Keys and vars"

lemma inKeys_inVars : "a≠0 ⟹ x ∈ keys m ⟹ x ∈ vars(MPoly_Type.monom m a)"
  by(simp add: vars_def)

lemma notInKeys_notInVars : "x ∉ keys m ⟹ x ∉ vars(MPoly_Type.monom m a)"
  by(simp add: vars_def)

lemma lookupNotIn : "x ∉ keys m ⟹ lookup m x = 0"
  by (simp add: in_keys_iff)

subsection "Degree Lemmas"

lemma degree_le_iff: "MPoly_Type.degree p x ≤ k ⟷ (∀m∈monomials p. lookup m x ≤ k)"
  by transfer simp

lemma degree_less_iff: "MPoly_Type.degree p x < k ⟷ (k>0 ∧ (∀m∈monomials p. lookup m x < k))"
  by (transfer fixing: k) (cases "k = 0"; simp)  

lemma degree_ge_iff: "k > 0 ⟹ MPoly_Type.degree p x ≥ k ⟷ (∃m∈monomials p. lookup m x ≥ k)"
  using Max_ge_iff by (meson degree_less_iff not_less) 

lemma degree_greater_iff: "MPoly_Type.degree p x > k ⟷ (∃m∈monomials p. lookup m x > k)"
  by transfer' (auto simp: Max_gr_iff)

lemma degree_eq_iff:
  "MPoly_Type.degree p x = k ⟷ (if k = 0
    then (∀m∈monomials p. lookup m x = 0)
    else (∃m∈monomials p. lookup m x = k) ∧ (∀m∈monomials p. lookup m x ≤ k))"
  by (subst eq_iff) (force simp: degree_le_iff degree_ge_iff intro!: antisym)

declare poly_mapping.lookup_inject[simp del]

lemma lookup_eq_and_update_lemma: "lookup m var = deg ∧ Poly_Mapping.update var 0 m = x ⟷
  m = Poly_Mapping.update var deg x ∧ lookup x var = 0"
  unfolding poly_mapping_eq_iff
  by (force simp: update.rep_eq fun_eq_iff)


lemma degree_const : "MPoly_Type.degree (Const (z::real)) (x::nat) = 0"
  by (simp add: degree_eq_iff monomials_Const)

lemma degree_one : "MPoly_Type.degree (Var x :: real mpoly) x = 1"
  by(simp add: degree_eq_iff monomials_Var)

subsection "Lemmas on treating a multivariate polynomial as univariate "
lemma coeff_isolate_variable_sparse:
  "MPoly_Type.coeff (isolate_variable_sparse p var deg) x =
  (if lookup x var = 0
  then MPoly_Type.coeff p (Poly_Mapping.update var deg x)
  else 0)"
  apply (transfer fixing: x var deg p)
  unfolding lookup_sum
  unfolding lookup_single
  apply (auto simp: when_def)
   apply (subst sum.inter_filter[symmetric])
  subgoal by simp
  subgoal by (simp add: lookup_eq_and_update_lemma Collect_conv_if)
  by (auto intro!: sum.neutral simp add: lookup_update)

lemma isovarspar_sum: 
  "isolate_variable_sparse (p+q) var deg = 
  isolate_variable_sparse (p) var deg
  + isolate_variable_sparse (q) var deg"
  apply (auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse )
   apply (metis More_MPoly_Type.coeff_add coeff_isolate_variable_sparse)
  by (metis More_MPoly_Type.coeff_add add.comm_neutral coeff_isolate_variable_sparse less_numeral_extra(3))

lemma isolate_zero[simp]: "isolate_variable_sparse 0 var n = 0"
  by transfer' (auto simp: mpoly_eq_iff)

lemma coeff_isolate_variable_sparse_minus_monomial:
  "MPoly_Type.coeff (isolate_variable_sparse mp var i) (m - monomial i var) =
  (if lookup m var ≤ i then MPoly_Type.coeff mp (Poly_Mapping.update var i m) else 0)"
  by (simp add: coeff_isolate_variable_sparse lookup_minus update_minus_monomial)

lemma sum_over_zero: "(mp::real mpoly) = (∑i::nat ≤MPoly_Type.degree mp x. isolate_variable_sparse mp x i * Var x^i)"
  by (auto simp add: mpoly_eq_iff coeff_sum coeff_mult_Var if_if_eq_conj not_le
      coeff_isolate_variable_sparse_minus_monomial when_def lookup_update degree_less_iff
      simp flip: eq_iff
      intro!: coeff_not_in_monomials)

lemma const_lookup_zero : "isolate_variable_sparse (Const p ::real mpoly) (x::nat) (0::nat) = Const p"
  by (auto simp: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Const when_def)
    (metis lookup_update_self)

lemma const_lookup_suc : "isolate_variable_sparse (Const p :: real mpoly) x (Suc i) = 0"
  apply(auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Const when_def)
  by (metis lookup_update lookup_zero nat.distinct(1))

lemma isovar_greater_degree : "∀i > MPoly_Type.degree p var. isolate_variable_sparse p var i = 0"
  apply(auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse degree_less_iff)
  by (metis coeff_not_in_monomials less_irrefl_nat lookup_update)

lemma isolate_var_0 : "isolate_variable_sparse (Var x::real mpoly) x 0 = 0"
  apply(auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Var when_def)
  by (metis gr0I lookup_single_eq lookup_update_self n_not_Suc_n)

lemma isolate_var_one : "isolate_variable_sparse (Var x :: real mpoly) x 1 = 1"
  by (auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Var coeff_eq_zero_iff)
    (smt More_MPoly_Type.coeff_monom One_nat_def add_diff_cancel_left' lookup_eq_and_update_lemma
      lookup_single_eq lookup_update_self monom_one plus_1_eq_Suc single_diff single_zero update_minus_monomial)

lemma isovarspase_monom :
  assumes notInKeys : "x ∉ keys m"
  assumes notZero : "a ≠ 0"
  shows "isolate_variable_sparse (MPoly_Type.monom m a) x 0 = (MPoly_Type.monom m a :: real mpoly)"
  using assms
  by (auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_eq_zero_iff in_keys_iff)
    (metis lookup_update_self)

lemma isolate_variable_spase_zero : "lookup m x = 0 ⟹
    insertion (nth L) ((MPoly_Type.monom m a)::real mpoly) = 0 ⟹
    a ≠ 0 ⟹ insertion (nth L) (isolate_variable_sparse (MPoly_Type.monom m a) x 0) = 0"
  by (simp add: isovarspase_monom lookup_eq_zero_in_keys_contradict notInKeys_notInVars)

lemma isovarsparNotIn : "x ∉ vars (p::real mpoly) ⟹ isolate_variable_sparse p x 0 = p"
proof(induction p rule: mpoly_induct)
  case (monom m a)
  then show ?case
    apply(cases "a=0")
    by (simp_all add: isovarspase_monom vars_monom_keys)
next
  case (sum p1 p2 m a)
  then show ?case 
    by (simp add: monomials.rep_eq vars_add_monom isovarspar_sum)
qed


lemma degree0isovarspar :
  assumes deg0 : "MPoly_Type.degree (p::real mpoly) x = 0"
  shows "isolate_variable_sparse p x 0 = p"
proof -
  have h1 : "p = (∑i::nat ≤MPoly_Type.degree p x. isolate_variable_sparse p x i * Var x ^ i)"
    using sum_over_zero by auto
  have h2a : "∀f. (∑i::nat ≤0. f i) = f 0"
    apply(simp add: sum_def)
    by (metis add.right_neutral comm_monoid_add_class.sum_def finite.emptyI insert_absorb insert_not_empty sum.empty sum.insert)
  have h2 : "p = isolate_variable_sparse p x 0 * Var x ^ 0"
    using deg0 h1 h2a by auto
  show ?thesis using h2
    by auto 
qed


subsection "Summation Lemmas"

lemma summation_normalized :
  assumes nonzero : "(B ::real) ≠0"
  shows "(∑i = 0..<((n::nat)+1). (f i :: real) * B ^ (n - i)) = (∑i = 0..<(n+1). (f i) / (B ^ i)) * (B^n)"
proof -
  have h1a : "∀x::real. ((∑i = 0..<(n+1). (f i) / (B ^ i)) * x = (∑i = 0..<(n+1). ((f i) / (B ^ i)) * x))"  
    apply(induction n )
     apply(auto)
    by (simp add: distrib_right)
  have h1 : "(∑i = 0..<(n+1). (f i) / (B ^ i)) * (B^n) = (∑i = 0..<(n+1). ((f i) / (B ^ i)) * (B^n))"
    using h1a by auto
  have h2 : "(∑i = 0..<(n+1). ((f i) / (B ^ i)) * (B^n)) = (∑i = 0..<(n+1). (f i) * ((B^n) / (B ^ i)))"
    by auto
  have h3 : "(∑i = 0..<(n+1). (f i) * ((B^n) / (B ^ i))) = (∑i = 0..<(n+1). (f i) * B ^ (n - i))"
    using add.right_neutral nonzero power_diff by fastforce
  show ?thesis using h1 h2 h3 by auto
qed

lemma normalize_summation :
  assumes nonzero : "(B::real)≠0"
  shows "(∑i = 0..<n+1. f i * B ^ (n - i))= 0
          ⟷
  (∑i = 0..<(n::nat)+1. (f i::real) / (B ^ i)) = 0"
proof - 
  have pow_zero : "∀i. B^(i :: nat)≠0" using nonzero by(auto)
  have single_division_zero : "∀X. B*(X::real)=0 ⟷ X=0" using nonzero by(auto)
  have h1: "(∑i = 0..<n+1. (f i) / (B ^ i)) = 0 ⟷ ((∑i = 0..<n+1. (f i) / (B ^ i)))*B^n = 0"
    using nonzero single_division_zero by(auto)
  have h2: "((∑i = 0..<n+1. (f i) / (B ^ i))*(B^n)) = ((∑i = 0..<n+1. (f i) * (B ^ (n- i))))"
    using summation_normalized nonzero by auto
  show ?thesis using h1 h2 by auto
qed


lemma normalize_summation_less :
  assumes nonzero : "(B::real)≠0"
  shows "(∑i = 0..<(n+1). (f i) * B ^ (n - i)) * B ^ (n mod 2) < 0
          ⟷
  (∑i = 0..<((n::nat)+1). (f i::real) / (B ^ i)) < 0"
proof - 
  have h1 : "(∑i = 0..<(n+1). (f i) * B ^ (n - i)) * B ^ (n mod 2) < 0
        ⟷  (∑i = 0..<(n+1). (f i) / (B ^ i)) * (B^n) * B ^ (n mod 2) < 0"
    using summation_normalized nonzero by auto
  have h2a : "n mod 2 = 0 ∨ n mod 2 = 1" by auto
  have h2b : "n mod 2 = 1 ⟹ odd n" by auto
  have h2c : "(B^n) * B ^ (n mod 2) > 0"
    using h2a h2b apply auto
    using nonzero apply presburger
    by (metis even_Suc mult.commute nonzero power_Suc zero_less_power_eq)    
  have h2 : "∀x. ((x * (B^n) * B ^ (n mod 2) < 0) = (x<0))"
    using h2c using mult.assoc by (metis mult_less_0_iff not_square_less_zero) 
  show ?thesis using h1 h2 by auto
qed

subsection "Additional Lemmas with Vars"

lemma not_in_isovarspar : "isolate_variable_sparse (p::real mpoly) var x = (q::real mpoly) ⟹ var∉(vars q)"
  apply(simp add: isolate_variable_sparse_def vars_def)
proof -
  assume a1: "MPoly (∑m | m ∈ monomials p ∧ lookup m var = x. monomial (MPoly_Type.coeff p m) (Poly_Mapping.update var 0 m)) = q"
  { fix pp :: "nat ⇒0 nat"
    have "isolate_variable_sparse p var x = q"
      using a1 isolate_variable_sparse.abs_eq by blast
    then have "var ∉ keys pp ∨ pp ∉ keys (mapping_of q)"
      by (metis (no_types) coeff_def coeff_isolate_variable_sparse in_keys_iff) }
  then show "∀p∈keys (mapping_of q). var ∉ keys p"
    by meson
qed 

lemma not_in_add : "var∉(vars (p::real mpoly)) ⟹ var∉(vars (q::real mpoly)) ⟹ var∉(vars (p+q))"
  by (meson UnE in_mono vars_add)

lemma not_in_mult : "var∉(vars (p::real mpoly)) ⟹ var∉(vars (q::real mpoly)) ⟹ var∉(vars (p*q))"
  by (meson UnE in_mono vars_mult)

lemma not_in_neg : "var∉(vars(p::real mpoly)) ⟷ var∉(vars(-p))"
proof -
  have h: "var ∉ (vars (-1::real mpoly))" by (metis add_diff_cancel_right' add_neg_numeral_special(8) isolate_var_one isolate_zero isovarsparNotIn isovarspar_sum not_in_isovarspar)
  show ?thesis using not_in_mult using h by fastforce
qed

lemma not_in_sub : "var∉(vars (p::real mpoly)) ⟹ var∉(vars (q::real mpoly)) ⟹ var∉(vars (p-q))"
  using not_in_add not_in_neg by fastforce


lemma not_in_pow : "var∉(vars(p::real mpoly)) ⟹ var∉(vars(p^i))"
proof (induction i)
  case 0
  then show ?case using isolate_var_one not_in_isovarspar
    by (metis power_0) 
next 
  case (Suc i)
  then show ?case using not_in_mult by simp
qed

lemma not_in_sum_var: "(∀i. var∉(vars(f(i)::real mpoly))) ⟹ var∉(vars(∑i∈{0..<(n::nat)}.f(i)))"
proof (induction n)
  case 0
  then show ?case using isolate_zero not_in_isovarspar by fastforce
next
  case (Suc n)
  have h1: "(sum f {0..<Suc n}) = (sum f {0..< n}) + (f n)" using sum.atLeast0_lessThan_Suc by blast
  have h2: "var ∉ vars (f n)" by (simp add: Suc.prems)
  then show ?case using h1 vars_add by (simp add: Suc.IH Suc.prems not_in_add)
qed

lemma not_in_sum : "(∀i. var∉(vars(f(i)::real mpoly))) ⟹ ∀(n::nat). var∉(vars(∑i∈{0..<n}.f(i)))"
  using not_in_sum_var by blast

lemma not_contains_insertion_helper : 
  "∀x∈keys (mapping_of p). var ∉ keys x ⟹
         (⋀k f. (k ∉ keys f) = (lookup f k = 0)) ⟹
         lookup (mapping_of p) a = 0 ∨
         (∏aa. (if aa < length L then L[var := y] ! aa else 0) ^ lookup a aa) =
         (∏aa. (if aa < length L then L[var := x] ! aa else 0) ^ lookup a aa)"
  apply(cases "lookup (mapping_of p) a = 0") 
   apply auto
  apply(rule Prod_any.cong) 
  apply auto
  using lookupNotIn nth_list_update_neq power_0 by smt

lemma not_contains_insertion : 
  assumes notIn : "var ∉ vars (p:: real mpoly)"
  assumes exists : "insertion (nth_default 0 (list_update L var x)) p = val"
  shows "insertion (nth_default 0 (list_update L var y)) p = val"
  using notIn exists
  apply(simp add: insertion_def insertion_aux_def insertion_fun_def)
  unfolding vars_def nth_default_def
  using not_in_keys_iff_lookup_eq_zero  
  apply auto
  apply(rule Sum_any.cong) 
  apply simp
  using not_contains_insertion_helper[of p var _ L y x]
proof -
  fix a :: "nat ⇒0 nat"
  assume a1: "∀x∈keys (mapping_of p). var ∉ keys x"
  assume "⋀k f. ((k::'a) ∉ keys f) = (lookup f k = 0)"
  then show "lookup (mapping_of p) a = 0 ∨ (∏n. (if n < length L then L[var := y] ! n else 0) ^ lookup a n) = (∏n. (if n < length L then L[var := x] ! n else 0) ^ lookup a n)"
    using a1 ‹⋀a. ⟦∀x∈keys (mapping_of p). var ∉ keys x; ⋀k f. (k ∉ keys f) = (lookup f k = 0)⟧ ⟹ lookup (mapping_of p) a = 0 ∨ (∏aa. (if aa < length L then L[var := y] ! aa else 0) ^ lookup a aa) = (∏aa. (if aa < length L then L[var := x] ! aa else 0) ^ lookup a aa)› by blast
qed


subsection "Insertion Lemmas"
lemma insertion_sum_var : "((insertion f (∑i∈{0..<(n::nat)}.g(i))) = (∑i∈{0..<n}. insertion f (g i)))"
proof (induction n)
  case 0
  then show ?case by auto
next
  case (Suc n)
  then show ?case by (simp add: insertion_add)
qed

(* changed to explicitly typecast n as a nat *)
lemma insertion_sum : "∀(n::nat). ((insertion f (∑i∈{0..<n}.g(i))) = (∑i∈{0..<n}. insertion f (g i)))"
  using insertion_sum_var by blast


lemma insertion_sum' : "⋀(n::nat). ((insertion f (∑i≤n. g(i))) = (∑i≤n. insertion f (g i)))"
  by (metis (no_types, lifting) fun_sum_commute insertion_add insertion_zero sum.cong) 

lemma insertion_pow : "insertion f (p^i) = (insertion f p)^i"
proof (induction i)
  case 0
  then show ?case by auto
next
  case (Suc n)
  then show ?case by (simp add: insertion_mult)
qed

lemma insertion_neg : "insertion f (-p) = -insertion f p"
  by (metis add.inverse_inverse insertionNegative)

lemma insertion_var : 
  "length L > var ⟹ insertion (nth_default 0 (list_update L var x)) (Var var) = x"
  by (auto simp: monomials_Var coeff_Var insertion_code nth_default_def)

lemma insertion_var_zero : "insertion (nth_default 0 (x#xs)) (Var 0) = x" using insertion_var
  by fastforce

lemma notIn_insertion_sub : "x∉vars(p::real mpoly) ⟹ x∉vars(q::real mpoly)
                             ⟹ insertion f (p-q) = insertion f p - insertion f q"
  by (metis ab_group_add_class.ab_diff_conv_add_uminus insertion_add insertion_neg)

lemma insertion_sub : "insertion f (A-B :: real mpoly) = insertion f A - insertion f B"
  using insertion_neg insertion_add
  by (metis uminus_add_conv_diff)

lemma insertion_four : "insertion ((nth_default 0) xs) 4 = 4"
  by (metis (no_types, lifting) insertion_add insertion_one numeral_plus_numeral one_add_one semiring_norm(2) semiring_norm(6))

lemma insertion_add_ind_basecase:
  "insertion (nth (list_update L var x)) ((∑i::nat ≤ 0. isolate_variable_sparse p var i * (Var var)^i))
  = (∑i = 0..<(0+1).  insertion (nth (list_update L var x)) (isolate_variable_sparse p var i * (Var var)^i))"
proof - 
  have h1: "((∑i::nat ≤ 0. isolate_variable_sparse p var i * (Var var)^i))
   = (isolate_variable_sparse p var 0 * (Var var)^0)"
    by auto
  show ?thesis using h1
    by auto 
qed

lemma insertion_add_ind:
  "insertion (nth_default 0 (list_update L var x)) ((∑i::nat ≤ d. isolate_variable_sparse p var i * (Var var)^i))
  = (∑i = 0..<(d+1).  insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse p var i * (Var var)^i))"
proof (induction d)
  case 0
  then show ?case using insertion_add_ind_basecase nth_default_def
    by auto
next
  case (Suc n)
  then show ?case using insertion_add apply auto
    by (simp add: insertion_add)
qed

lemma sum_over_degree_insertion :
  assumes lLength : "length L > var"
  assumes deg : "MPoly_Type.degree (p::real mpoly) var = d"
  shows "(∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse p var i) * (x^i))
          = insertion (nth_default 0 (list_update L var x)) p"
proof -
  have h1: "(p::real mpoly) = (∑i::nat ≤(MPoly_Type.degree p var). isolate_variable_sparse p var i * (Var var)^i)" using sum_over_zero by auto
  have h2: "insertion (nth_default 0 (list_update L var x)) p = 
    insertion (nth_default 0 (list_update L var x)) ((∑i::nat ≤ d. isolate_variable_sparse p var i * (Var var)^i))" using h1 deg by auto
  have h3:  "insertion (nth_default 0 (list_update L var x)) p = (∑i = 0..<(d+1).  insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse p var i * (Var var)^i))"
    using h2 insertion_add_ind nth_default_def
    by (simp add: )
  show ?thesis using h3 insertion_var insertion_pow
    by (metis (no_types, lifting) insertion_mult lLength sum.cong)
qed



lemma insertion_isovarspars_free :
  "insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse (p::real mpoly) var (i::nat))
  =insertion (nth_default 0 (list_update L var y)) (isolate_variable_sparse (p::real mpoly) var (i::nat))"
proof -
  have h : "var ∉ vars(isolate_variable_sparse (p::real mpoly) var (i::nat))"
    by (simp add: not_in_isovarspar)
  then show ?thesis using not_contains_insertion
    by blast 
qed
lemma insertion_zero : "insertion f (Const 0 ::real mpoly) = 0"
  by (metis add_cancel_right_right add_zero insertion_zero)

lemma insertion_one : "insertion f (Const 1 ::real mpoly) = 1"
  by (metis insertion_one mult.right_neutral mult_one_left)

lemma insertion_const : "insertion f (Const c::real mpoly) = (c::real)"
  by (auto simp: monomials_Const coeff_Const insertion_code)


subsection "Putting Things Together"
subsubsection "More Degree Lemmas"
lemma degree_add_leq : 
  assumes h1 : "MPoly_Type.degree a var ≤ x"
  assumes h2 : "MPoly_Type.degree b var ≤ x"
  shows "MPoly_Type.degree (a+b) var ≤ x"
  using degree_eq_iff coeff_add coeff_not_in_monomials
  by (smt (z3) More_MPoly_Type.coeff_add add.left_neutral coeff_eq_zero_iff degree_le_iff h1 h2)

lemma degree_add_less : 
  assumes h1 : "MPoly_Type.degree a var < x"
  assumes h2 : "MPoly_Type.degree b var < x"
  shows "MPoly_Type.degree (a+b) var < x"
proof -
  obtain pp :: "nat ⇒ nat ⇒ 'a mpoly ⇒ nat ⇒0 nat" where
    "∀x0 x1 x2. (∃v3. v3 ∈ monomials x2 ∧ ¬ lookup v3 x1 < x0) = (pp x0 x1 x2 ∈ monomials x2 ∧ ¬ lookup (pp x0 x1 x2) x1 < x0)"
    by moura
  then have f1: "∀m n na. (¬ MPoly_Type.degree m n < na ∨ 0 < na ∧ (∀p. p ∉ monomials m ∨ lookup p n < na)) ∧ (MPoly_Type.degree m n < na ∨ ¬ 0 < na ∨ pp na n m ∈ monomials m ∧ ¬ lookup (pp na n m) n < na)"
    by (metis (no_types) degree_less_iff)
  then have "0 < x ∧ (∀p. p ∉ monomials a ∨ lookup p var < x)"
    using assms(1) by presburger
  then show ?thesis
    using f1 by (metis MPolyExtension.coeff_add add.left_neutral assms(2) coeff_eq_zero_iff)
qed

lemma degree_sum : "(∀i∈{0..n::nat}. MPoly_Type.degree (f i :: real mpoly) var ≤ x) ⟹ (MPoly_Type.degree (∑x∈{0..n}. f x) var) ≤ x"
proof(induction n)
  case 0
  then show ?case by auto
next
  case (Suc n)
  then show ?case by(simp add: degree_add_leq)
qed

lemma degree_sum_less : "(∀i∈{0..n::nat}. MPoly_Type.degree (f i :: real mpoly) var < x) ⟹ (MPoly_Type.degree (∑x∈{0..n}. f x) var) < x"
proof(induction n)
  case 0
  then show ?case by auto
next
  case (Suc n)
  then show ?case by(simp add: degree_add_less)
qed


lemma varNotIn_degree : 
  assumes "var ∉ vars p"
  shows "MPoly_Type.degree p var = 0"
proof-
  have "∀m∈monomials p. lookup m var = 0"
    using assms unfolding vars_def keys_def
    using monomials.rep_eq by fastforce
  then show ?thesis
    using degree_less_iff by blast
qed

lemma degree_mult_leq : 
  assumes pnonzero: "(p::real mpoly)≠0"
  assumes qnonzero: "(q::real mpoly)≠0"
  shows "MPoly_Type.degree ((p::real mpoly) * (q::real mpoly)) var ≤ (MPoly_Type.degree p var) + (MPoly_Type.degree q var)"
proof(cases "MPoly_Type.degree (p*q) var =0")
  case True
  then show ?thesis by simp
next
  case False
  have hp: "∀m∈monomials p. lookup m var ≤ MPoly_Type.degree p var" using degree_eq_iff
    by (metis zero_le) 
  have hq: "∀m∈monomials q. lookup m var ≤ MPoly_Type.degree q var" using degree_eq_iff
    by (metis zero_le) 
  have hpq: "∀m∈{a+b | a b . a ∈ monomials p ∧ b ∈ monomials q}.
      lookup m var ≤ (MPoly_Type.degree p var) + (MPoly_Type.degree q var)"
    by (smt add_le_mono hp hq mem_Collect_eq plus_poly_mapping.rep_eq)
  have h1: "(∀m∈monomials (p*q). lookup m var ≤ (MPoly_Type.degree p var) + (MPoly_Type.degree q var))" 
    using mult_monomials_dir_one hpq
    by blast 
  then show ?thesis using h1 degree_eq_iff False
    by (simp add: degree_le_iff)
qed

lemma degree_exists_monom: 
  assumes "p≠0"
  shows  "∃m∈monomials p. lookup m var = MPoly_Type.degree p var"
proof(cases "MPoly_Type.degree p var =0")
  case True
  have h1: "∃m∈monomials p. lookup m var = 0" unfolding monomials_def
    by (metis True assms(1) aux degree_eq_iff in_keys_iff mapping_of_inject monomials.rep_eq monomials_def zero_mpoly.rep_eq)
  then show ?thesis using h1
    using True by simp
next
  case False
  then show ?thesis using degree_eq_iff assms(1) apply(auto)
    by (metis degree_eq_iff dual_order.strict_iff_order) 
qed

lemma degree_not_exists_monom: 
  assumes "p≠0"
  shows  "¬ (∃ m∈monomials p. lookup m var > MPoly_Type.degree p var)"
proof - 
  show ?thesis using degree_less_iff by blast 
qed

lemma degree_monom: "MPoly_Type.degree (MPoly_Type.monom x y) v = (if y = 0 then 0 else lookup x v)"
  by (auto simp: degree_eq_iff)

lemma degree_plus_disjoint:
  "MPoly_Type.degree (p + MPoly_Type.monom m c) v = max (MPoly_Type.degree p v) (MPoly_Type.degree (MPoly_Type.monom m c) v)"
  if "m ∉ monomials p"
  for p::"real mpoly"
  using that
  apply (subst degree_eq_iff)
  apply (auto simp: monomials_add_disjoint)
            apply (auto simp: degree_eq_iff degree_monom)
       apply (metis MPoly_Type.degree_zero degree_exists_monom less_numeral_extra(3))
  using degree_le_iff apply blast
  using degree_eq_iff
     apply (metis max_def neq0_conv)
    apply (metis degree_eq_iff max.coboundedI1 neq0_conv)
   apply (metis MPoly_Type.degree_zero degree_exists_monom max_def zero_le)
  using degree_le_iff max.cobounded1 by blast

subsubsection "More isolate\\_variable\\_sparse lemmas"

lemma isolate_variable_sparse_ne_zeroD:
  "isolate_variable_sparse mp v x ≠ 0 ⟹ x ≤ MPoly_Type.degree mp v"
  using isovar_greater_degree leI by blast

context includes poly.lifting begin
lift_definition mpoly_to_nested_poly::"'a::comm_monoid_add mpoly ⇒ nat ⇒ 'a mpoly Polynomial.poly" is
  "λ(mp::'a mpoly) (v::nat) (p::nat). isolate_variable_sparse mp v p"
  ― ‹note const‹extract_var› nests the other way around›
  unfolding MOST_iff_cofinite
proof -
  fix mp::"'a mpoly" and v::nat
  have "{p. isolate_variable_sparse mp v p ≠ 0} ⊆ {0..MPoly_Type.degree mp v}"
    (is "?s ⊆ _")
    by (auto dest!: isolate_variable_sparse_ne_zeroD)
  also have "finite …" by simp
  finally (finite_subset) show "finite ?s" .
qed

lemma degree_eq_0_mpoly_to_nested_polyI:
  "mpoly_to_nested_poly mp v = 0 ⟹ MPoly_Type.degree mp v = 0"
  apply transfer'
  apply (simp add: degree_eq_iff)
  apply transfer'
  apply (auto simp: fun_eq_iff)
proof -
  fix mpa :: "'a mpoly" and va :: nat and m :: "nat ⇒0 nat"
  assume a1: "∀x. (∑m | m ∈ monomials mpa ∧ lookup m va = x. monomial (MPoly_Type.coeff mpa m) (Poly_Mapping.update va 0 m)) = 0"
  assume a2: "m ∈ monomials mpa"
  have f3: "∀m p. lookup (mapping_of m) p ≠ (0::'a) ∨ p ∉ monomials m"
    by (metis (full_types) coeff_def coeff_eq_zero_iff)
  have f4: "∀n. mapping_of (isolate_variable_sparse mpa va n) = 0"
    using a1 by (simp add: isolate_variable_sparse.rep_eq)
  have "∀p n. lookup 0 (p::nat ⇒0 nat) = (0::'a) ∨ (0::nat) = n"
    by simp
  then show "lookup m va = 0"
    using f4 f3 a2 by (metis coeff_def coeff_isolate_variable_sparse lookup_eq_and_update_lemma)
qed

lemma coeff_eq_zero_mpoly_to_nested_polyD: "mpoly_to_nested_poly mp v = 0 ⟹ MPoly_Type.coeff mp 0 = 0"
  apply transfer'
  apply transfer'
  by (metis (no_types) coeff_def coeff_isolate_variable_sparse isolate_variable_sparse.rep_eq lookup_zero update_0_0)

lemma mpoly_to_nested_poly_eq_zero_iff[simp]:
  "mpoly_to_nested_poly mp v = 0 ⟷ mp = 0"
  apply (auto simp: coeff_eq_zero_mpoly_to_nested_polyD degree_eq_0_mpoly_to_nested_polyI)
proof -
  show "mpoly_to_nested_poly mp v = 0 ⟹ mp = 0" 
    apply (frule degree_eq_0_mpoly_to_nested_polyI)
    apply (frule coeff_eq_zero_mpoly_to_nested_polyD)
    apply (transfer' fixing: mp v)
    apply (transfer' fixing: mp v)
    apply (auto simp: fun_eq_iff mpoly_eq_iff intro!: sum.neutral)
  proof -
    fix m :: "nat ⇒0 nat"
    assume a1: "∀x. (∑m | m ∈ monomials mp ∧ lookup m v = x. monomial (MPoly_Type.coeff mp m) (Poly_Mapping.update v 0 m)) = 0"
    assume a2: "MPoly_Type.degree mp v = 0"
    have "∀n. isolate_variable_sparse mp v n = 0"
      using a1 by (simp add: isolate_variable_sparse.abs_eq zero_mpoly.abs_eq)
    then have f3: "∀p. MPoly_Type.coeff mp p = MPoly_Type.coeff 0 p ∨ lookup p v ≠ 0"
      by (metis (no_types) coeff_isolate_variable_sparse lookup_update_self)
    then show "MPoly_Type.coeff mp m = 0"
      using a2 coeff_zero
      by (metis coeff_not_in_monomials degree_eq_iff)
  qed
  show "mp = 0 ⟹ mpoly_to_nested_poly 0 v = 0" 
    subgoal
      apply transfer'
      apply transfer'
      by (auto simp: fun_eq_iff intro!: sum.neutral)
    done
qed

lemma isolate_variable_sparse_degree_eq_zero_iff: "isolate_variable_sparse p v (MPoly_Type.degree p v) = 0 ⟷ p = 0"
  apply (transfer')
  apply auto
proof -
  fix pa :: "'a mpoly" and va :: nat
  assume "(∑m | m ∈ monomials pa ∧ lookup m va = MPoly_Type.degree pa va. monomial (MPoly_Type.coeff pa m) (Poly_Mapping.update va 0 m)) = 0"
  then have "mapping_of (isolate_variable_sparse pa va (MPoly_Type.degree pa va)) = 0"
    by (simp add: isolate_variable_sparse.rep_eq)
  then show "pa = 0"
    by (metis (no_types) coeff_def coeff_eq_zero_iff coeff_isolate_variable_sparse degree_exists_monom lookup_eq_and_update_lemma lookup_zero)
qed

lemma degree_eq_univariate_degree: "MPoly_Type.degree p v =
    (if p = 0 then 0 else Polynomial.degree (mpoly_to_nested_poly p v))"
  apply auto
  apply (rule antisym)
  subgoal
    apply (rule Polynomial.le_degree)
    apply (auto simp: )
    apply transfer'
    by (simp add: isolate_variable_sparse_degree_eq_zero_iff)
  subgoal apply (rule Polynomial.degree_le)
    apply (auto simp: elim!: degree_eq_zeroE)
    apply transfer'
    by (simp add: isovar_greater_degree)
  done

lemma compute_mpoly_to_nested_poly[code]:
  "coeffs (mpoly_to_nested_poly mp v) =
    (if mp = 0 then []
    else map (isolate_variable_sparse mp v) [0..<Suc(MPoly_Type.degree mp v)])"
  unfolding coeffs_def unfolding mpoly_to_nested_poly_eq_zero_iff degree_eq_univariate_degree apply auto
  subgoal by transfer' (rule refl)
  by transfer' (rule refl)

end

lemma isolate_variable_sparse_monom: "isolate_variable_sparse (MPoly_Type.monom m a) v i =
  (if a = 0 ∨ lookup m v ≠ i then 0 else MPoly_Type.monom (Poly_Mapping.update v 0 m) a)"
proof -
  have *: "{x. x = m ∧ lookup x v = i} = (if lookup m v = i then {m} else {})"
    by auto
  show ?thesis
    by (transfer' fixing: m a v i) (simp add:*)
qed



lemma isolate_variable_sparse_monom_mult:
  "isolate_variable_sparse (MPoly_Type.monom m a * q) v n =
    (if n ≥ lookup m v
    then MPoly_Type.monom (Poly_Mapping.update v 0 m) a * isolate_variable_sparse q v (n - lookup m v)
    else 0)"
  for q::"'a::semiring_no_zero_divisors mpoly"
  apply (auto simp: MPoly_Type.mult_monom)
  subgoal
    apply transfer'
    subgoal for mon v i a q
      apply (auto simp add: monomials_monom_mult sum_distrib_left)
      apply (rule sum.reindex_bij_witness_not_neutral[where
            j="λa. a - mon"
            and i="λa. mon + a"
            and S'="{}"
            and T'="{}"
            ])
              apply (auto simp: lookup_add)
      apply (auto simp: poly_mapping_eq_iff fun_eq_iff single.rep_eq Poly_Mapping.mult_single)
      apply (auto simp: when_def More_MPoly_Type.coeff_monom_mult)
      by (auto simp: lookup_update lookup_add split: if_splits)
    done
  subgoal
    apply transfer'
    apply (auto intro!: sum.neutral simp: monomials_monom_mult )
    apply (rule poly_mapping_eqI)
    apply (auto simp: lookup_single when_def)
    by (simp add: lookup_add)
  done

lemma isolate_variable_sparse_mult:
  "isolate_variable_sparse (p * q) v n = (∑i≤n. isolate_variable_sparse p v i * isolate_variable_sparse q v (n - i))"
  for p q::"'a::semiring_no_zero_divisors mpoly"
proof (induction p rule: mpoly_induct)
  case (monom m a)
  then show ?case
    by (cases "a = 0")
      (auto simp add: mpoly_eq_iff coeff_sum coeff_mult if_conn if_distrib if_distribR
        isolate_variable_sparse_monom isolate_variable_sparse_monom_mult
        cong: if_cong)
next
  case (sum p1 p2 m a)
  then show ?case
    by (simp add: distrib_right isovarspar_sum sum.distrib)
qed

subsubsection "More Miscellaneous"
lemma var_not_in_Const : "var∉vars (Const x :: real mpoly)"
  unfolding vars_def keys_def
  by (smt UN_iff coeff_def coeff_isolate_variable_sparse const_lookup_zero keys_def lookup_eq_zero_in_keys_contradict) 

lemma mpoly_to_nested_poly_mult:
  "mpoly_to_nested_poly (p * q) v = mpoly_to_nested_poly p v * mpoly_to_nested_poly q v"
  for p q::"'a::{comm_semiring_0, semiring_no_zero_divisors} mpoly"
  by (auto simp: poly_eq_iff coeff_mult mpoly_to_nested_poly.rep_eq isolate_variable_sparse_mult)

lemma get_if_const_insertion : 
  assumes "get_if_const (p::real mpoly) = Some r"
  shows "insertion f p = r"
proof-
  have "Set.is_empty (vars p)"
    apply(cases "Set.is_empty (vars p)")
     apply(simp) using assms by(simp)
  then have "(MPoly_Type.coeff p 0) = r"
    using assms by simp
  then show ?thesis
    by (metis Set.is_empty_def ‹Set.is_empty (vars p)› empty_iff insertion_irrelevant_vars insertion_trivial)
qed

subsubsection "Yet more Degree Lemmas"
lemma degree_mult:
  fixes p q::"'a::{comm_semiring_0, ring_1_no_zero_divisors} mpoly"
  assumes "p ≠ 0"
  assumes "q ≠ 0"
  shows "MPoly_Type.degree (p * q) v = MPoly_Type.degree p v + MPoly_Type.degree q v"
  using assms
  by (auto simp add: degree_eq_univariate_degree mpoly_to_nested_poly_mult Polynomial.degree_mult_eq)

lemma degree_eq:
  assumes "(p::real mpoly) = (q:: real mpoly)"
  shows "MPoly_Type.degree p x = MPoly_Type.degree q x"
  by (simp add: assms)

lemma degree_var_i : "MPoly_Type.degree (((Var x)^i:: real mpoly)) x = i"
proof (induct i)
  case 0
  then show ?case using degree_const
    by simp
next
  case (Suc i)
  have multh: "(Var x)^(Suc i) = ((Var x)^i::real mpoly) * (Var x:: real mpoly)"
    using power_Suc2 by blast
  have deg0h: "MPoly_Type.degree 0 x = 0"
    by simp
  have deg1h: "MPoly_Type.degree (Var x::real mpoly) x = 1"
    using degree_one
    by blast 
  have nonzeroh1: "(Var x:: real mpoly) ≠ 0" 
    using degree_eq deg0h deg1h by auto 
  have nonzeroh2: "((Var x)^i:: real mpoly) ≠ 0" 
    using degree_eq deg0h Suc.hyps
    by (metis one_neq_zero power_0) 
  have sumh: "(MPoly_Type.degree (((Var x)^i:: real mpoly) * (Var x:: real mpoly)) x) = (MPoly_Type.degree ((Var x)^i::real mpoly) x) + (MPoly_Type.degree (Var x::real mpoly) x)"
    using degree_mult[where p = "(Var x)^i::real mpoly", where q = "Var x::real mpoly"]  nonzeroh1 nonzeroh2
    by blast 
  then show ?case using sumh deg1h
    by (metis Suc.hyps Suc_eq_plus1 multh) 
qed


lemma degree_less_sum: 
  assumes "MPoly_Type.degree (p::real mpoly) var = n"
  assumes "MPoly_Type.degree (q::real mpoly) var = m"
  assumes "m < n"
  shows "MPoly_Type.degree (p + q) var = n"
proof - 
  have h1: "n > 0"
    using assms(3) neq0_conv by blast
  have h2: "(∃m∈monomials p. lookup m var = n) ∧ (∀m∈monomials p. lookup m var ≤ n)"
    using degree_eq_iff assms(1)
    by (metis degree_ge_iff h1 order_refl)
  have h3: "(∃m∈monomials (p + q). lookup m var = n)"
    using h2
    by (metis MPolyExtension.coeff_add add.right_neutral assms(2) assms(3) coeff_eq_zero_iff degree_not_exists_monom) 
  have h4: "(∀m∈monomials (p + q). lookup m var ≤ n)"
    using h2 assms(3) assms(2)
    using degree_add_leq degree_le_iff dual_order.strict_iff_order by blast
  show ?thesis using degree_eq_iff h3 h4
    by (metis assms(3) gr_implies_not0) 
qed

lemma degree_less_sum': 
  assumes "MPoly_Type.degree (p::real mpoly) var = n"
  assumes "MPoly_Type.degree (q::real mpoly) var = m"
  assumes "n < m"
  shows "MPoly_Type.degree (p + q) var = m" using degree_less_sum[OF assms(2) assms(1) assms(3)]
  by (simp add: add.commute) 

(* Result on the degree of the derivative  *)

lemma nonzero_const_is_nonzero: 
  assumes "(k::real) ≠ 0"
  shows "((Const k)::real mpoly) ≠ 0"
  by (metis MPoly_Type.insertion_zero assms insertion_const)

lemma degree_derivative : 
  assumes "MPoly_Type.degree p x > 0"
  shows "MPoly_Type.degree p x = MPoly_Type.degree (derivative x p) x + 1"
proof -
  define f where "f i = (isolate_variable_sparse p x (i+1) * (Var x)^(i) * (Const (i+1)))" for i
  define n where "n = MPoly_Type.degree p x-1"
  have d : "∃m∈monomials p. lookup m x = n+1"
    using n_def degree_eq_iff assms
    by (metis add.commute less_not_refl2 less_one linordered_semidom_class.add_diff_inverse)    
  have h1a : "∀i. MPoly_Type.degree (isolate_variable_sparse p x i) x = 0"
    by (simp add: not_in_isovarspar varNotIn_degree)
  have h1b : "∀i::nat. MPoly_Type.degree ((Var x)^i:: real mpoly) x = i"
    using degree_var_i by auto
  have h1c1 : "∀i. (Var(x)^(i)::real mpoly)≠0"
    by (metis MPoly_Type.degree_zero h1b power_0 zero_neq_one)
  have h1c1var: "((Var x)^i:: real mpoly) ≠ 0" using h1c1 by blast
  have h1c2 : "((Const ((i::nat) + 1))::real mpoly)≠0"
    using nonzero_const_is_nonzero
    by auto 
  have h1c3: "(isolate_variable_sparse p x (n + 1)) ≠ 0" using d
    by (metis One_nat_def Suc_pred add.commute assms isolate_variable_sparse_degree_eq_zero_iff n_def not_gr_zero not_in_isovarspar plus_1_eq_Suc varNotIn_degree)
  have h3: "(isolate_variable_sparse p x (i+1) = 0) ⟶ (MPoly_Type.degree (f i) x) = 0"
    by (simp add: f_def)
  have degh1: "(MPoly_Type.degree (((Const ((i::nat)+1))::real mpoly)*(Var x)^i) x) = 
    ((MPoly_Type.degree ((Const (i+1))::real mpoly) x) + (MPoly_Type.degree ((Var x)^i:: real mpoly) x))"
    using h1c2 h1c1var degree_mult[where p="((Const ((i::nat)+1))::real mpoly)", where q="((Var x)^i:: real mpoly)"]
    by blast
  then have degh2: "(MPoly_Type.degree (((Const ((i::nat)+1))::real mpoly)*(Var x)^i) x) = i" 
    using degree_var_i degree_const
    by simp 
  have nonzerohyp: "(((Const ((i::nat)+1))::real mpoly)*(Var x)^i) ≠ 0"
  proof (induct i)
    case 0
    then show ?case
      by (simp add: nonzero_const_is_nonzero) 
  next
    case (Suc i)
    then show ?case using degree_eq degh2
      by (metis Suc_eq_plus1 h1c1 mult_eq_0_iff nat.simps(3) nonzero_const_is_nonzero of_nat_eq_0_iff)
  qed
  have h4a1: "(isolate_variable_sparse p x (i+1) ≠ 0) ⟶ (MPoly_Type.degree (isolate_variable_sparse p x (i+1) * ((Var x)^(i) * (Const (i+1)))::real mpoly) x = 
      (MPoly_Type.degree (isolate_variable_sparse p x (i+1):: real mpoly) x) + (MPoly_Type.degree (((Const (i+1)) *  (Var x)^(i))::real mpoly) x))"
    using nonzerohyp degree_mult[where p = "(isolate_variable_sparse p x (i+1))::real mpoly", where q = "((Const (i+1)) *  (Var x)^(i)):: real mpoly", where v = "x"]
    by (simp add: mult.commute)
  have h4: "(isolate_variable_sparse p x (i+1) ≠ 0) ⟶ (MPoly_Type.degree (f i) x) = i"
    using h4a1 f_def degh2 h1a
    by (metis (no_types, hide_lams) add.left_neutral mult.commute mult.left_commute of_nat_1 of_nat_add) 
  have h5: "(MPoly_Type.degree (f i) x) ≤ i" using h3 h4 by auto
  have h6: "(MPoly_Type.degree (f n) x) = n" using h1c3 h4
    by (smt One_nat_def add.right_neutral add_Suc_right degree_const degree_mult divisors_zero f_def h1a h1b h1c1 mult.commute nonzero_const_is_nonzero of_nat_1 of_nat_add of_nat_neq_0) 
  have h7a: "derivative x p = (∑i∈{0..MPoly_Type.degree p x-1}. isolate_variable_sparse p x (i+1) * (Var x)^i * (Const (i+1)))" using derivative_def by auto
  have h7b: "(∑i∈{0..MPoly_Type.degree p x-1}. isolate_variable_sparse p x (i+1) * (Var x)^i * (Const (i+1))) = (∑i∈{0..MPoly_Type.degree p x-1}. (f i))" using f_def
    by (metis Suc_eq_plus1 add.commute semiring_1_class.of_nat_simps(2)) 
  have h7c: "derivative x p = (∑i∈{0..MPoly_Type.degree p x-1}. (f i))" using h7a h7b by auto
  have h7: "derivative x p = (∑i∈{0..n}. (f i))" using n_def h7c
    by blast 
  have h8: "n > 0 ⟶ ((MPoly_Type.degree (∑i∈{0..(n-1)}. (f i)) x) < n)"
  proof (induct n)
    case 0
    then show ?case
      by blast 
  next
    case (Suc n)
    then show ?case using h5 degree_less_sum
      by (smt add_cancel_right_right atLeastAtMost_iff degree_const degree_mult degree_sum_less degree_var_i diff_Suc_1 f_def h1a le_imp_less_Suc mult.commute mult_eq_0_iff)
  qed 
  have h9a: "n = 0 ⟶ MPoly_Type.degree (∑i∈{0..n}. (f i)) x = n" using h6
    by auto   
  have h9b: "n > 0 ⟶ MPoly_Type.degree (∑i∈{0..n}. (f i)) x = n" 
  proof - 
    have h9bhyp: "n > 0 ⟶ (MPoly_Type.degree (∑i∈{0..n}. (f i)) x = MPoly_Type.degree ((∑i∈{0..(n-1)}. (f i)) + (f n)) x)"
      by (metis Suc_diff_1 sum.atLeast0_atMost_Suc)
    have h9bhyp2: "n > 0 ⟶ ((MPoly_Type.degree ((∑i∈{0..(n-1)}. (f i)) + (f n)) x) = n)" 
      using h6 h8 degree_less_sum
      by (simp add: add.commute) 
    then show ?thesis using h9bhyp2 h9bhyp
      by linarith
  qed
  have h9:  "MPoly_Type.degree (∑i∈{0..n}. (f i)) x = n" using h9a h9b
    by blast 
  have h10: "MPoly_Type.degree (derivative x p) x = n" using h9 h7
    by simp
  show ?thesis using h10 n_def
    using assms by linarith
qed


lemma express_poly :
  assumes h : "MPoly_Type.degree (p::real mpoly) var = 1 ∨ MPoly_Type.degree p var = 2"
  shows "p =
     (isolate_variable_sparse p var 2)*(Var var)^2
    +(isolate_variable_sparse p var 1)*(Var var)
    +(isolate_variable_sparse p var 0)"
proof-
  have h1a: "MPoly_Type.degree p var = 1 ⟶ p =
    isolate_variable_sparse p var 0 + 
    isolate_variable_sparse p var 1 * Var var"
    using sum_over_zero[where mp="p",where x="var"]
    by auto
  have h1b: "MPoly_Type.degree p var = 1 ⟶ isolate_variable_sparse p var 2 = 0"
    using isovar_greater_degree
    by (simp add: isovar_greater_degree)
  have h1: "MPoly_Type.degree p var = 1 ⟶ p =
    isolate_variable_sparse p var 0 + 
    isolate_variable_sparse p var 1 * Var var
    + isolate_variable_sparse p var 2 * (Var var)^2" using h1a h1b by auto
  have h2a: "MPoly_Type.degree p var = 2 ⟶ p = (∑i::nat ≤ 2. isolate_variable_sparse p var i * Var var^i)"
    using sum_over_zero[where mp="p", where x="var"] by auto
  have h2b: "(∑i::nat ≤ 2. isolate_variable_sparse p var i * Var var^i) =
   (∑i::nat ≤ 1. isolate_variable_sparse p var i * Var var^i) +
   isolate_variable_sparse p var 2 * (Var var)^2" apply auto
    by (simp add: numerals(2))
  have h2:  "MPoly_Type.degree p var = 2 ⟶ p =
    isolate_variable_sparse p var 0 + 
    isolate_variable_sparse p var 1 * Var var + 
    isolate_variable_sparse p var 2 * (Var var)^2"
    using h2a h2b by auto
  have h3: "isolate_variable_sparse p var 0 + 
    isolate_variable_sparse p var 1 * Var var + 
    isolate_variable_sparse p var 2 * (Var var)^2 = 
    isolate_variable_sparse p var 2 * (Var var)^2 +
    isolate_variable_sparse p var 1 * Var var + 
    isolate_variable_sparse p var 0" by (simp add: add.commute)

  show ?thesis using h h1 h2 h3 by presburger
qed

lemma degree_isovarspar : "MPoly_Type.degree (isolate_variable_sparse (p::real mpoly) x i) x = 0"
  using not_in_isovarspar varNotIn_degree by blast 


end

Theory PolyAtoms

section "Atoms"
theory PolyAtoms
  imports ExecutiblePolyProps
begin

subsection "Definition"

datatype (atoms: 'a) fm =
  TrueF | FalseF | Atom 'a | And "'a fm" "'a fm" | Or "'a fm" "'a fm" |
  Neg "'a fm" | ExQ "'a fm" | AllQ "'a fm" | ExN "nat" "'a fm" | AllN "nat" "'a fm"

definition neg where
  "neg φ = (if φ=TrueF then FalseF else if φ=FalseF then TrueF else Neg φ)"

definition "and" :: "'a fm ⇒ 'a fm ⇒ 'a fm" where
  "and φ1 φ2 =
 (if φ1=TrueF then φ2 else if φ2=TrueF then φ1 else
  if φ1=FalseF ∨ φ2=FalseF then FalseF else And φ1 φ2)"

definition or :: "'a fm ⇒ 'a fm ⇒ 'a fm" where
  "or φ1 φ2 =
 (if φ1=FalseF then φ2 else if φ2=FalseF then φ1 else
  if φ1=TrueF ∨ φ2=TrueF then TrueF else Or φ1 φ2)"

definition list_conj :: "'a fm list ⇒ 'a fm" where
  "list_conj fs = foldr and fs TrueF"

definition list_disj :: "'a fm list ⇒ 'a fm" where
  "list_disj fs = foldr or fs FalseF"

text "
The atom datatype corresponds to the defined in Tobias's LinearQuantifierElim.
"

datatype atom = Less "real mpoly" | Eq "real mpoly" | Leq "real mpoly" | Neq "real mpoly"

text
  "
For each atom, the real mpoly corresponds to a polynomial from the Polynomials library where
we allow for real valued coefficients.

The variables in the polynomials are in De Bruijn notation where variable 0 corresponds to the
variable of the innermost quantifier, then variable 1 is the next quantifier out from that, and
so on. Any variable number greater than the number of quantifiers is a free variable. This means
that we have a list of infinite free variables we can pick from and if we want to refer to the
ith free variable (indexed at 0)  within an atom that is bound in j quantifiers, then we would use
var (i+j).

The polynomials are all standardized so that they are compared to a 0 on the right. This means 
the atom Less p corresponds to $p\\leq0$ and the atom Eq p corresponds to $p=0$ and so on. This
restriction doesn't lose any generality and having all 4 of these kinds of atoms prevents loss
of efficiency as the negation of these atoms do not introduce additional logical connectives. The
following aNeg function demonstrates this.
"

fun aNeg :: "atom ⇒ atom" where
  "aNeg (Less p) = Leq (-p)" |
  "aNeg (Eq p) = Neq p" |
  "aNeg (Leq p) = Less (-p)" |
  "aNeg (Neq p) = Eq p"

subsection "Evaluation"

text "
In order to do any proofs with these atoms, we need a method of comparing two atoms to check if they
are equal. Instead of trying to manipulate the polynomials to a standard form to compare them, it
is a lot easier to plug in values for every variable and check if the results are equal. If every
single real value input for each variable matches in truth value for both atoms, then they are equal.

aEval a l corresponds to plugging in the real value list l into the variables of atom a and then
evaluating the truth value of it
"
fun aEval :: "atom ⇒ real list ⇒ bool" where
  "aEval (Eq p) L = (insertion (nth_default 0 L) p = 0)" |
  "aEval (Less p) L = (insertion (nth_default 0 L) p < 0)" |
  "aEval (Leq p) L = (insertion (nth_default 0 L) p ≤ 0)" |
  "aEval (Neq p) L = (insertion (nth_default 0 L) p ≠ 0)"


text "
aNeg\\_aEval shows the general format for how things are proven equal. Plugging in the values to an
original atom a will results in the opposite truth value if we transformed with the aNeg function.
"
lemma aNeg_aEval : "aEval a L ⟷ (¬ aEval (aNeg a) L)"
  apply(cases a)
     apply(auto)
     apply(smt insertionNegative)
    apply(smt insertionNegative)
   apply(smt insertionNegative)
  apply(smt insertionNegative)
  done

text "
We can extend this to formulas instead of just atoms. Given a formula in prenex normal form,
we simply iterate through and apply the quantifiers
"


fun eval :: "atom fm ⇒ real list ⇒ bool" where
  "eval (Atom a) Γ = aEval a Γ" |
  "eval (TrueF) _ = True" |
  "eval (FalseF) _ = False" |
  "eval (And φ ψ) Γ = ((eval φ Γ) ∧ (eval ψ Γ))" |
  "eval (Or φ ψ) Γ = ((eval φ Γ) ∨ (eval ψ Γ))" |
  "eval (Neg φ) Γ = (¬ (eval φ Γ))" |
  "eval (ExQ φ) Γ = (∃x. (eval φ (x#Γ)))" |
  "eval (AllQ φ) Γ = (∀x. (eval φ (x#Γ)))"|
  "eval (AllN i φ) Γ = (∀l. length l = i ⟶ (eval φ (l @ Γ)))"|
  "eval (ExN i φ) Γ = (∃l. length l = i ∧ (eval φ (l @ Γ)))"


lemma "eval (ExQ (Or (Atom A) (Atom B))) xs =  eval (Or (ExQ(Atom A)) (ExQ(Atom B))) xs"
  by(auto)


lemma eval_neg_neg : "eval (neg (neg f)) L ⟷ eval f L"
  by (simp add: neg_def)

lemma eval_neg : "(¬ eval (neg f) L) ⟷ eval f L"
  by (simp add: neg_def)

lemma eval_and : "eval (and a b) L ⟷ (eval a L ∧ eval b L)"
  by (simp add: and_def)

lemma eval_or : "eval (or a b) L ⟷ (eval a L ∨ eval b L)"
  by (simp add: or_def)

lemma eval_Or : "eval (Or a b) L ⟷ (eval a L ∨ eval b L)"
  by (simp)

lemma eval_And : "eval (And a b) L ⟷ (eval a L ∧ eval b L)"
  by (simp)

lemma eval_not : "eval (neg a) L ⟷ ¬(eval a L)"
  by (simp add: neg_def)

lemma eval_true : "eval TrueF L"
  by simp

lemma eval_false : "¬(eval FalseF L)"
  by simp

lemma eval_Neg : "eval (Neg φ) L = eval (neg φ) L"
  by (simp add: eval_not)

lemma eval_Neg_Neg : "eval (Neg (Neg φ)) L = eval φ L"
  by (simp add: eval_not)


lemma eval_Neg_And : "eval (Neg (And φ ψ)) L = eval (Or (Neg φ) (Neg ψ)) L"
  by simp

lemma aEval_leq : "aEval (Leq p) L = (aEval (Less p) L ∨ aEval (Eq p) L)"
  by auto

text "This function is misleading because it is true iff 
  the variable given doesn't occur as a free variable in the atom fm"
fun freeIn :: "nat ⇒ atom fm ⇒ bool" where
  "freeIn var (Atom(Eq p)) = (var ∉ (vars p))"|
  "freeIn var (Atom(Less p)) = (var ∉ (vars p))"|
  "freeIn var (Atom(Leq p)) = (var ∉ (vars p))"|
  "freeIn var (Atom(Neq p)) = (var ∉ (vars p))"|
  "freeIn var (TrueF) = True"|
  "freeIn var (FalseF) = True"|
  "freeIn var (And a b) = ((freeIn var a) ∧ (freeIn var b))"|
  "freeIn var (Or a b) = ((freeIn var a) ∧ (freeIn var b))"|
  "freeIn var (Neg a) = freeIn var a"|
  "freeIn var (ExQ a) = freeIn (var+1) a"|
  "freeIn var (AllQ a) = freeIn (var+1) a"|
  "freeIn var (AllN i a) = freeIn (var+i) a"|
  "freeIn var (ExN i a) = freeIn (var+i) a"



fun liftmap :: "(nat ⇒ atom ⇒ atom fm) ⇒ atom fm ⇒ nat ⇒ atom fm" where
  "liftmap f TrueF var = TrueF"|
  "liftmap f FalseF var = FalseF"|
  "liftmap f (Atom a) var = f var a"|
  "liftmap f (And φ ψ) var = And (liftmap f φ var) (liftmap f ψ var)"|
  "liftmap f (Or φ ψ) var = Or (liftmap f φ var) (liftmap f ψ var)"|
  "liftmap f (Neg φ) var = Neg (liftmap f φ var)"|
  "liftmap f (ExQ φ) var = ExQ (liftmap f φ (var+1))"|
  "liftmap f (AllQ φ) var = AllQ (liftmap f φ (var+1))"|
  "liftmap f (AllN i φ) var = AllN i (liftmap f φ (var+i))"|
  "liftmap f (ExN i φ) var = ExN i (liftmap f φ (var+i))"

(*
fun greatestFreeVariable :: "atom fm ⇒ nat option" where
"greatestFreeVariable F = None"

fun is_closed :: "atom fm ⇒ real list ⇒ bool" where
"is_closed F xs = (case greatestFreeVariable F of Some x ⇒ (x = length xs) | None ⇒ (0=length xs))"
*)

fun depth :: "'a fm ⇒ nat"where
  "depth TrueF = 1"|
  "depth FalseF = 1"|
  "depth (Atom _) = 1"|
  "depth (And φ ψ) = max (depth φ) (depth ψ) + 1"|
  "depth (Or φ ψ) = max (depth φ) (depth ψ) + 1"|
  "depth (Neg φ) = depth φ + 1"|
  "depth (ExQ φ) = depth φ + 1"|
  "depth (AllQ φ) = depth φ + 1"|
  "depth (AllN i φ) = depth φ + 1"|
  "depth (ExN i φ) = depth φ + 1"

value "AllQ (And 
    (ExQ (Atom (Eq (Var 1 * Var 2 - (Var 0)^2 * Var 3))))
    (Neg (AllQ (Atom (Leq (Const 5 * (Var 1)^2 - Var 0)))))
)"

fun negation_free :: "atom fm ⇒ bool" where 
  "negation_free TrueF = True" |
  "negation_free FalseF = True " |
  "negation_free (Atom a) = True" |
  "negation_free (And φ1 φ2) = ((negation_free φ1) ∧ (negation_free φ2))" |
  "negation_free (Or φ1 φ2) = ((negation_free φ1) ∧ (negation_free φ2))" |
  "negation_free (ExQ φ) = negation_free φ" |
  "negation_free (AllQ φ) = negation_free φ" |
  "negation_free (AllN i φ) = negation_free φ" |
  "negation_free (ExN i φ) = negation_free φ" |
  "negation_free (Neg _) = False"

subsection "Useful Properties"

lemma sum_eq : "eval (Atom(Eq p)) L ⟶ eval (Atom(Eq q)) L ⟶ eval (Atom(Eq(p + q))) L"
  by (simp add: insertion_add)

lemma freeIn_list_conj : "(∀f∈set(F). freeIn var f) ⟹ freeIn var (list_conj F)"
proof(induct F)
  case Nil
  then show ?case by(simp add: list_conj_def)
next
  case (Cons a F)
  then show ?case by (simp add: PolyAtoms.and_def list_conj_def)
qed

lemma freeIn_list_disj : 
  assumes "∀f∈set (L::atom fm list). freeIn var f"
  shows "freeIn var (list_disj L)"
  using assms
proof(induction L)
  case Nil
  then show ?case unfolding list_disj_def  by auto
next
  case (Cons a L)
  then show ?case unfolding list_disj_def or_def by simp
qed

lemma var_not_in_aEval : "freeIn var (Atom φ) ⟹ (∃x. aEval φ (list_update L var x)) = (∀x. aEval φ (list_update L var x))"
proof(induction φ)
  case (Less p)
  then show ?case
    apply(auto)
    using not_contains_insertion 
    by metis
next
  case (Eq p)
  then show ?case
    apply(auto)
    using not_contains_insertion
    by blast 
next
  case (Leq p)
  then show ?case
    apply(auto)
    using not_contains_insertion
    by metis
next
  case (Neq p)
  then show ?case 
    apply(auto)
    using not_contains_insertion
    by metis
qed

lemma var_not_in_aEval2 : "freeIn 0 (Atom φ) ⟹ (∃x. aEval φ (x#L)) = (∀x. aEval φ (x#L))"
  by (metis list_update_code(2) var_not_in_aEval) 

lemma plugInLinear :
  assumes lLength : "length L>var"
  assumes nonzero : "B≠0"
  assumes hb : "∀v. insertion (nth_default 0 (list_update L var v)) b = B"
  assumes hc : "∀v. insertion (nth_default 0 (list_update L var v)) c = C"
  shows "aEval (Eq(b*Var var + c)) (list_update L var (-C/B))"
  by(simp add: lLength insertion_add insertion_mult nonzero hb hc insertion_var)


subsection "Some eval results"
lemma doubleExist : "eval (ExN 2 A) L = eval (ExQ (ExQ A)) L"
  apply(simp)
proof(safe)
  fix l
  assume h : "length l = 2" "eval A (l @ L)"
  show "∃x xa. eval A (xa # x # L)"
  proof(cases l)
    case Nil
    then show ?thesis using h by auto
  next
    case (Cons a list)
    then have Cons' : "l = a # list" by auto
    then show ?thesis proof(cases list)
      case Nil
      then show ?thesis using h Cons  by auto
    next
      case (Cons b list)
      show ?thesis
        apply(rule exI[where x=b])apply(rule exI[where x=a])
        using h Cons' Cons  by auto
    qed
  qed
next
  fix x xa
  assume h : "eval A (xa # x # L)"
  show "∃l. length l = 2 ∧ eval A (l @ L)"
    apply(rule exI[where x="[xa,x]"]) using h by simp
qed

lemma doubleForall : "eval (AllN 2 A) L = eval (AllQ (AllQ A)) L"
  apply(simp)using doubleExist eval_neg by fastforce

lemma unwrapExist : "eval (ExN (j + 1) A) L = eval (ExQ (ExN j A)) L"
  apply simp
  apply safe
  subgoal for l
    apply(rule exI[where x="nth l j"])
    apply(rule exI[where x="take j l"])
    apply auto
    by (metis Cons_nth_drop_Suc append.assoc append_Cons append_eq_append_conv_if append_take_drop_id lessI)
  subgoal for x l
    apply(rule exI[where x="l @ [x]"])
    by auto
  done

lemma unwrapExist' : "eval (ExN (j + 1) A) L =  eval (ExN j (ExQ A)) L"
  apply simp
  apply safe
  subgoal for l
    apply(rule exI[where x="drop 1 l"])
    apply auto
    apply(rule exI[where x="nth l 0"])
    by (metis Cons_nth_drop_Suc append_Cons drop0 zero_less_Suc)
  subgoal for l x
    apply(rule exI[where x="x#l"])
    by auto
  done

lemma unwrapExist'' : "eval (ExN (i + j) A) L = eval (ExN i(ExN j A)) L"
  apply simp
  apply safe
  subgoal for l
    apply(rule exI[where x="drop j l"])
    apply auto
    apply(rule exI[where x="take j l"])
    apply auto
    by (metis append.assoc append_take_drop_id)
  subgoal for l la
    apply(rule exI[where x="la@l"])
    by auto
  done

lemma unwrapForall : "eval (AllN (j + 1) A) L = eval (AllQ (AllN j A)) L"
  using unwrapExist[of j "neg A" L] eval_neg by fastforce

lemma unwrapForall' : "eval (AllN (j + 1) A) L =  eval (AllN j (AllQ A)) L"
  using unwrapExist'[of j "neg A" L] eval_neg by fastforce

lemma unwrapForall'' : "eval (AllN (i + j) A) L = eval (AllN i(AllN j A)) L"
  using unwrapExist''[of i j "neg A" L] eval_neg by fastforce

lemma var_not_in_eval : "∀var. ∀L. (freeIn var φ ⟶ ((∃x. eval φ (list_update L var x)) = (∀x. eval φ (list_update L var x))))"
proof(induction φ)
  case TrueF
  then show ?case by(auto)
next
  case FalseF
  then show ?case by(auto)
next
  case (Atom x)
  then show ?case
    using var_not_in_aEval eval.simps(1) by blast
next
  case (And φ1 φ2)
  then show ?case by (meson eval.simps(4) freeIn.simps(7)) 
next
  case (Or φ1 φ2)
  then show ?case by fastforce 
next
  case (Neg φ)
  then show ?case by (meson eval.simps(6) freeIn.simps(9))
next
  case (ExQ φ)
  fix xa L var x
  have  "(xa::real) # L[var := x] = (xa#L)[var+1:=x]"
    by simp
  then show ?case using ExQ
    by (metis Suc_eq_plus1 eval.simps(7) freeIn.simps(10) list_update_code(3))
next
  case (AllQ φ)
  fix xa L var x
  have  "(xa::real) # L[var := x] = (xa#L)[var+1:=x]"
    by simp
  then show ?case using AllQ
    by (metis Suc_eq_plus1 eval.simps(8) freeIn.simps(11) list_update_code(3))
next
  case (ExN i φ)
  {fix xa L var x
    assume "length (xa::real list) = i"
    have  "xa @ L[var := x] = (xa@L)[var+i:=x]"
      by (simp add: ‹length xa = i› list_update_append)
  }
  then show ?case using ExN
    by (metis eval.simps(10) freeIn.simps(13))
next
  case (AllN i φ)
  {fix xa L var x
    assume "length (xa::real list) = i"
    have  "xa @ L[var := x] = (xa@L)[var+i:=x]"
      by (simp add: ‹length xa = i› list_update_append)
  }
  then show ?case using AllN
    by (metis eval.simps(9) freeIn.simps(12))
qed

lemma var_not_in_eval2 : "∀L. (freeIn 0 φ ⟶ ((∃x. eval φ (x#L)) = (∀x. eval φ (x#L))))"
  by (metis list_update_code(2) var_not_in_eval)

lemma var_not_in_eval3 :
  assumes "freeIn var φ"
  assumes "length xs' = var"
  shows "((∃x. eval φ (xs'@x#L)) = (∀x. eval φ (xs'@x#L)))"
  using assms
  by (metis list_update_length var_not_in_eval) 

lemma eval_list_conj : "eval (list_conj F) L = (∀f∈set(F). eval f L)"
proof -
  { fix f F
    have h : "eval (foldr and F f) L = (eval f L ∧ (∀f ∈ set F. eval f L))"
      apply(induct F)
       apply simp
      using eval_and by auto
  } then show ?thesis
    by(simp add:list_conj_def)
qed


lemma eval_list_disj : "eval (list_disj F) L = (∃f∈set(F). eval f L)"
proof -
  { fix f F
    have h : "eval (foldr or F f) L = (eval f L ∨ (∃f ∈ set F. eval f L))"
      apply(induct F)
       apply simp
      using eval_or by auto
  } then show ?thesis
    by(simp add:list_disj_def)
qed
end

Theory Debruijn

section "Debruijn Indicies Formulation"
theory Debruijn
  imports PolyAtoms
begin
subsection "Lift and Lower Functions"

text "these functions are required for debruijn notation
  the (liftPoly n a p) functions increment each variable greater n in polynomial p by a
  the (lowerPoly n a p) functions lower each variable greater than n by a so variables n through n+a-1 shouldn't exist
"
context includes poly_mapping.lifting begin

definition "inc_above b i x = (if x < b then x else x + i::nat)"
definition "dec_above b i x = (if x ≤ b then x else x - i::nat)"

lemma inc_above_dec_above: "x < b ∨ b + i ≤ x ⟹ inc_above b i (dec_above b i x) = x"
  by (auto simp: inc_above_def dec_above_def)
lemma dec_above_inc_above: "dec_above b i (inc_above b i x) = x"
  by (auto simp: inc_above_def dec_above_def)

lemma inc_above_dec_above_iff: "inc_above b i (dec_above b i x) = x ⟷ x < b ∨ b + i ≤ x"
  by (auto simp: inc_above_def dec_above_def)

lemma inj_on_dec_above: "inj_on (dec_above b i) {x. x < b ∨ b + i ≤ x}"
  by (rule inj_on_inverseI[where g = "inc_above b i"]) (auto simp: inc_above_dec_above)

lemma finite_inc_above_ne: "finite {x. f x ≠ c} ⟹ finite {x. f (inc_above b i x) ≠ c}"
proof -
  fix b and f::"nat⇒'a"
  assume f: "finite {x. f x ≠ c}"
  moreover
  have "finite {x. f (x + i) ≠ c}"
  proof -
    have "{x. f (x + i) ≠ c} = (+) i -` {x. f x ≠ c}"
      by (auto simp: ac_simps)
    also have "finite …"
      by (rule finite_vimageI) (use f in auto)
    finally show ?thesis .
  qed
  ultimately have "finite ({x. f x ≠ c} ∪ {x. f (x + i) ≠ c})"
    by auto
  from _ this show "finite {x. f (inc_above b i x) ≠ c}"
    by (rule finite_subset) (auto simp: inc_above_def)
qed

lemma finite_dec_above_ne: "finite {x. f x ≠ c} ⟹ finite {x. f (dec_above b i x) ≠ c}"
proof -
  fix b and f::"nat⇒'a"
  assume f: "finite {x. f x ≠ c}"
  moreover
  have "finite {x. f (x - i) ≠ c}"
  proof -
    have "{x. f (x - i) ≠ c} ⊆ {0..i} ∪ ((λx. x - i) -` {x. f x ≠ c} ∩ {i<..})"
      by auto
    also have "finite …"
      apply (rule finite_UnI[OF finite_atLeastAtMost])
      by (rule finite_vimage_IntI) (use f in ‹auto simp: inj_on_def›)
    finally (finite_subset) show ?thesis .
  qed
  ultimately have "finite ({x. f x ≠ c} ∪ {x. f (x - i) ≠ c} ∪ {b})"
    by auto
  from _ this show "finite {x. f (dec_above b i x) ≠ c}"
    by (rule finite_subset) (auto simp: dec_above_def)
qed

lift_definition lowerPowers::"nat ⇒ nat ⇒ (nat ⇒0 'a) ⇒ (nat ⇒0 'a::zero)"
  is "λb i p x. if x ∈ {b..<b+i} then 0 else p (dec_above b i x)::'a"
proof -
  fix b i::nat and p::"nat ⇒ 'a"
  assume "finite {x. p x ≠ 0}"
  then have "finite {x. p (dec_above b i x) ≠ 0}"
    by (rule finite_dec_above_ne)
  from _ this show "finite {x. (if x ∈ {b..<b+i} then 0 else p (dec_above b i x)) ≠ 0}"
    by (rule finite_subset) auto
qed

lift_definition higherPowers::"nat ⇒ nat ⇒ (nat ⇒0 'a) ⇒ (nat ⇒0 'a::zero)"
  is "λb i p x. p (inc_above b i x)::'a"
  by (simp_all add: finite_inc_above_ne)

lemma higherPowers_lowerPowers: "higherPowers n i (lowerPowers n i x) = x"
  by transfer (force simp: dec_above_def inc_above_def antisym_conv2)

lemma inj_lowerPowers: "inj (lowerPowers b i)"
  using higherPowers_lowerPowers
  by (rule inj_on_inverseI)

lemma lowerPowers_higherPowers:
  "(⋀j. n ≤ j ⟹ j < n + i ⟹ lookup x j = 0) ⟹ lowerPowers n i (higherPowers n i x) = x"
  by (transfer fixing: n i) (force simp: inc_above_dec_above)

lemma inj_on_higherPowers: "inj_on (higherPowers n i) {x. ∀j. n ≤ j ∧ j < n + i ⟶ lookup x j = 0}"
  using lowerPowers_higherPowers
  by (rule inj_on_inverseI) auto

lemma higherPowers_eq: "lookup (higherPowers b i p) x = lookup p (inc_above b i x)"
  by (simp_all add: higherPowers.rep_eq)

lemma lowerPowers_eq: "lookup (lowerPowers b i p) x = (if b ≤ x ∧ x < b + i then 0 else lookup p (dec_above b i x))"
  by (auto simp add: lowerPowers.rep_eq)

lemma keys_higherPowers: "keys (higherPowers b i m) = dec_above b i ` (keys m ∩ {x. x ∉ {b..<b+i}})"
  apply safe
  subgoal for x
    apply (rule image_eqI[where x="inc_above b i x"])
     apply (auto simp: dec_above_inc_above in_keys_iff higherPowers.rep_eq)
    by (metis add_less_cancel_right inc_above_def leD)
  subgoal for x
    by (auto simp: inc_above_dec_above in_keys_iff higherPowers.rep_eq)
  done

context includes fmap.lifting begin

lift_definition lowerPowersf::"nat ⇒ nat ⇒ (nat, 'a) fmap ⇒ (nat, 'a::zero) fmap"
  is "λb i p x. if x ∈ {b..<b+i} then None else p (dec_above b i x)"
proof -
  fix b i::nat and p::"nat ⇒ 'a option"
  assume "finite (dom p)"
  then have "finite {x. p x ≠ None}" by (simp add: dom_def)

  have "dom (λx. p (dec_above b i x)) = {x. p (dec_above b i x) ≠ None}"
    by auto
  also have "finite …"
    by (rule finite_dec_above_ne) fact
  finally
  have "finite (dom (λx. p (dec_above b i x)))" .
  from _ this
  show "finite (dom (λx. if x ∈ {b..<b+i} then None else p (dec_above b i x)))"
    by (rule finite_subset) (auto split: if_splits)
qed

lift_definition higherPowersf::"nat ⇒ nat ⇒ (nat, 'a) fmap ⇒ (nat, 'a) fmap"
  is "λb i f x. f (inc_above b i x)"
proof -
  fix b i::nat and f::"nat ⇒ 'a option"
  assume "finite (dom f)"
  then have "finite {i. f i ≠ None}" by (simp add: dom_def)

  have "dom (λx. f (inc_above b i x)) = {x. f (inc_above b i x) ≠ None}"
    by auto
  also have "finite …"
    by (rule finite_inc_above_ne) fact
  finally show "finite (dom (λx. f (inc_above b i x)))"
    .
qed

lemma map_of_map_key_inverse_fun_eq:
  "map_of (map (λ(k, y). (f k, y)) xs) x = map_of xs (g x)"
  if "⋀x. x ∈ set xs ⟹ g (f (fst x)) = fst x" "f (g x) = x"
  for f::"'a ⇒ 'b"
  using that
proof (induction xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  from Cons
  have IH: "map_of (map (λa. (f (fst a), snd a)) xs) x = map_of xs (g x)"
    by (auto simp: split_beta')
  have inv_into: "g (f (fst a)) = fst a"
    by (rule Cons) simp
  show ?case
    using Cons
    by (auto simp add: split_beta' inv_into IH)
qed

lemma map_of_filter_key_in: "P x ⟹ map_of (filter (λ(k, v). P k) xs) x = map_of xs x"
  by (induction xs) (auto simp: )

lemma map_of_eq_NoneI: "x∉fst`set xs ⟹ map_of xs x = None"
  by (induction xs) (auto simp: )

lemma compute_higherPowersf[code]: "higherPowersf b i (fmap_of_list xs) =
  fmap_of_list (map (λ(k, v). (if k < b then k else k - i, v)) (filter (λ(k, v). k ∉ {b..<b+i}) xs))"
proof -
  have *: "map_of (map (λ(k, y). (if k < b then k else k - i, y)) (filter (λ(k, v).  b ≤ k ⟶ ¬ k < b + i) xs)) x =
    map_of (filter (λ(k, v).  b ≤ k ⟶ ¬ k < b + i) xs) (if x < b then x else x + i)"
    for x
    by (rule map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k + i"
          and f = "λk. if k < b then k else k - i"]) auto
  show ?thesis
    by (auto
        simp add: * higherPowersf.rep_eq lowerPowersf.rep_eq fmlookup_of_list fmlookup_default_def 
        inc_above_def
        map_of_filter_key_in
        split: option.splits
        intro!: fmap_ext)
qed

lemma compute_lowerPowersf[code]: "lowerPowersf b i (fmap_of_list xs) =
  fmap_of_list (map (λ(k, v). (if k < b then k else k + i, v)) xs)"
  apply (auto 
      simp add: lowerPowersf.rep_eq fmlookup_of_list fmlookup_default_def 
      dec_above_def
      map_of_filter_key_in
      split: option.splits
      intro!: fmap_ext)
  subgoal by (rule map_of_eq_NoneI[symmetric]) (auto split: if_splits)
  subgoal by (subst map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k - i"]) auto
  subgoal by (subst map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k - i"]) auto
  subgoal by (rule map_of_eq_NoneI[symmetric]) (auto split: if_splits)
  subgoal by (subst map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k - i"]) auto
  done

lemma compute_higherPowers[code]: "higherPowers n i (Pm_fmap xs) = Pm_fmap (higherPowersf n i xs)"
  by (rule poly_mapping_eqI)
    (auto simp: higherPowersf.rep_eq higherPowers.rep_eq fmlookup_default_def dec_above_def
      split: option.splits)

lemma compute_lowerPowers[code]: "lowerPowers n i (Pm_fmap xs) = Pm_fmap (lowerPowersf n i xs)"
  by (rule poly_mapping_eqI)
    (auto simp: lowerPowersf.rep_eq lowerPowers.rep_eq fmlookup_default_def dec_above_def
      split: option.splits)

lemma finite_nonzero_coeff: "finite {x. MPoly_Type.coeff mpoly x ≠ 0}"
  by transfer auto

lift_definition lowerPoly0::"nat ⇒ nat ⇒ ((nat⇒0nat)⇒0'a::zero) ⇒ ((nat⇒0nat)⇒0 'a)" is
  "λb i (mp::(nat⇒0nat)⇒'a) mon. mp (lowerPowers b i mon)"
proof -
  fix b i and mp::"(nat ⇒0 nat) ⇒ 'a"
  assume "finite {x. mp x ≠ 0}"
  have "{x. mp (lowerPowers b i x) ≠ 0} = (lowerPowers b i -` {x. mp x ≠ 0})"
    (is "?set = ?vimage")
    by auto
  also 
  from finite_vimageI[OF ‹finite _› inj_lowerPowers]
  have "finite ?vimage" .
  finally show "finite ?set" .
qed

lemma higherPowers_zero[simp]: "higherPowers b i 0 = 0"
  by transfer auto

lemma keys_lowerPoly0: "keys (lowerPoly0 b i mp) = higherPowers b i ` (keys mp ∩ {x. ∀j∈{b..<b+i}. lookup x j = 0})"
  apply (auto )
  subgoal for x
    apply (rule image_eqI[where x="lowerPowers b i x"])
     apply (auto simp: higherPowers_lowerPowers in_keys_iff lowerPoly0.rep_eq lowerPowers.rep_eq)
    done
  subgoal for x
    apply (auto simp: in_keys_iff lowerPoly0.rep_eq)
    apply (subst (asm) lowerPowers_higherPowers)
     apply auto
    done
  done


lift_definition higherPoly0::"nat ⇒ nat ⇒ ((nat⇒0nat)⇒0'a::zero) ⇒ ((nat⇒0nat)⇒0 'a)" is
  "λb i (mp::(nat⇒0nat)⇒'a) mon.
    if (∃j∈{b..<b+i}. lookup mon j > 0)
    then 0
    else mp (higherPowers b i mon)"
proof -
  fix b i and mp::"(nat ⇒0 nat) ⇒ 'a"
  assume "finite {x. mp x ≠ 0}"
  have "{x. (if ∃j∈{b..<b + i}. 0 < lookup x j then 0 else mp (higherPowers b i x)) ≠ 0} ⊆
    insert 0 (higherPowers b i -` {x. mp x ≠ 0} ∩ {x. ∀j∈{b..<b+i}. lookup x j = 0})"
    (is "?set ⊆ ?vimage")
    by auto
  also
  from finite_vimage_IntI[OF ‹finite _› inj_on_higherPowers, of b i]
  have "finite ?vimage" by (auto simp: Ball_def)
  finally (finite_subset) show "finite ?set" .
qed


context includes fmap.lifting begin

lift_definition lowerPolyf::"nat ⇒ nat ⇒ ((nat⇒0nat), 'a::zero)fmap ⇒ ((nat⇒0nat), 'a)fmap" is
  "λb i (mp::((nat⇒0nat)⇀'a)) mon::(nat⇒0nat). mp (lowerPowers b i mon)"
proof -― ‹TODO: this is exactly the same proof as the one for ‹lowerPoly0››
  fix b i and mp::"(nat ⇒0 nat) ⇒ 'a option"
  assume "finite (dom mp)"
  also have "dom mp = {x. mp x ≠ None}" by auto
  finally have "finite {x. mp x ≠ None}" .
  have "(dom (λmon. mp (lowerPowers b i mon))) = {mon. mp (lowerPowers b i mon) ≠ None}"
    (is "?set = _")
    by (auto split: if_splits)
  also have "… = lowerPowers b i -` {x. mp x ≠ None}" (is "_ = ?vimage")
    by auto
  also
  from finite_vimageI[OF ‹finite {x. mp x ≠ None}› inj_lowerPowers]
  have "finite ?vimage" .
  finally show "finite ?set" .
qed

lift_definition higherPolyf::"nat ⇒ nat ⇒ ((nat⇒0nat), 'a::zero)fmap ⇒ ((nat⇒0nat), 'a)fmap" is
  "λb i (mp::((nat⇒0nat)⇀'a)) mon::(nat⇒0nat).
    if (∃j∈{b..<b+i}. lookup mon j > 0)
    then None
    else mp (higherPowers b i mon)"
proof -
  fix b i and mp::"(nat ⇒0 nat) ⇀ 'a"
  assume "finite (dom mp)"
  have "dom (λx. (if ∃j∈{b..<b + i}. 0 < lookup x j then None else mp (higherPowers b i x))) ⊆
    insert 0 (higherPowers b i -` (dom mp) ∩ {x. ∀j∈{b..<b+i}. lookup x j = 0})"
    (is "?set ⊆ ?vimage")
    by (auto split: if_splits)
  also
  from finite_vimage_IntI[OF ‹finite _› inj_on_higherPowers, of b i]
  have "finite ?vimage" by (auto simp: Ball_def)
  finally (finite_subset) show "finite ?set" .
qed


lemma keys_lowerPowers: "keys (lowerPowers b i m) = inc_above b i ` (keys m)"
  apply safe
  subgoal for x
    apply (rule image_eqI[where x="dec_above b i x"])
     apply (auto simp: inc_above_dec_above in_keys_iff lowerPowers.rep_eq)
     apply (metis inc_above_dec_above not_less)
    by meson
  by (metis higherPowers.rep_eq higherPowers_lowerPowers in_keys_iff)


lemma keys_higherPoly0: "keys (higherPoly0 b i mp) = lowerPowers b i ` (keys mp)"
  apply (auto )
  subgoal for x
    apply (rule image_eqI[where x="higherPowers b i x"])
     apply (auto simp: lowerPowers_higherPowers in_keys_iff higherPoly0.rep_eq higherPowers.rep_eq)
     apply (metis atLeastLessThan_iff lowerPowers_higherPowers neq0_conv)
    by meson
  subgoal for x
    apply (auto simp: in_keys_iff higherPoly0.rep_eq)
     apply (simp add: lowerPowers_eq)
    by (simp add: higherPowers_lowerPowers)
  done

end

lemma inc_above_id[simp]: "n < m ⟹ inc_above m i n = n" by (auto simp: inc_above_def)
lemma inc_above_Suc[simp]: "n ≥ m ⟹ inc_above m i n = n + i" by (auto simp: inc_above_def)

lemma compute_lowerPoly0[code]: "lowerPoly0 n i (Pm_fmap m) = Pm_fmap (lowerPolyf n i m)"
  by (auto simp: lowerPoly0.rep_eq fmlookup_default_def lowerPolyf.rep_eq
      split: option.splits
      intro!: poly_mapping_eqI)

lemma compute_higherPoly0[code]: "higherPoly0 n i (Pm_fmap m) = Pm_fmap (higherPolyf n i m)"
  by (auto simp: higherPoly0.rep_eq fmlookup_default_def higherPolyf.rep_eq
      split: option.splits
      intro!: poly_mapping_eqI)

lemma compute_lowerPolyf[code]: "lowerPolyf n i (fmap_of_list xs) =
  (fmap_of_list (map (λ(mon, c). (higherPowers n i mon, c))
    (filter (λ(mon, v). ∀j∈{n..<n+i}. lookup mon j = 0) xs)))"
  apply (rule sym)
  apply (rule fmap_ext)
  unfolding lowerPolyf.rep_eq fmlookup_of_list
  apply (subst map_of_map_key_inverse_fun_eq[where g="lowerPowers n i"])
  subgoal
    by (auto simp add: lowerPowers_higherPowers)
  subgoal by (auto simp add: higherPowers_lowerPowers)
  apply (auto simp: fmlookup_of_list lowerPolyf.rep_eq map_of_eq_None_iff map_of_filter_key_in
      fmdom'_fmap_of_list higherPowers.rep_eq lowerPowers.rep_eq dec_above_def
      intro!: fmap_ext)
  done

lemma compute_higherPolyf[code]: "higherPolyf n i (fmap_of_list xs) =
  fmap_of_list (filter (λ(mon, v). ∀j∈{n..<n+i}. lookup mon j = 0)
    (map (λ(mon, c). (lowerPowers n i mon, c)) xs))"
  apply (rule sym)
  apply (rule fmap_ext)
  unfolding higherPolyf.rep_eq fmlookup_of_list
  apply auto
  subgoal
    by (rule map_of_eq_NoneI) auto
  subgoal
    apply (subst map_of_filter_key_in)
    apply auto
    apply (subst map_of_map_key_inverse_fun_eq[where g="higherPowers n i"])
    subgoal
      by (auto simp add: higherPowers_lowerPowers)
    subgoal by (auto simp add: lowerPowers_higherPowers)
    apply (auto simp: fmlookup_of_list lowerPolyf.rep_eq map_of_eq_None_iff map_of_filter_key_in
        fmdom'_fmap_of_list higherPowers.rep_eq lowerPowers.rep_eq dec_above_def
        intro!: fmap_ext)
    done
  done

end

lift_definition lowerPoly::"nat ⇒ nat ⇒ 'a::zero mpoly ⇒ 'a mpoly" is lowerPoly0 .
lift_definition liftPoly::"nat ⇒ nat ⇒ 'a::zero mpoly ⇒ 'a mpoly" is higherPoly0 .

lemma coeff_lowerPoly: "MPoly_Type.coeff (lowerPoly b i mp) x = MPoly_Type.coeff mp (lowerPowers b i x)"
  by (transfer') (simp add: lowerPoly0.rep_eq lowerPowers.rep_eq)

lemma coeff_liftPoly: "MPoly_Type.coeff (liftPoly b i mp) x = (if (∃j∈{b..<b+i}. lookup x j > 0)
    then 0
    else MPoly_Type.coeff mp (higherPowers b i x))"
  by (transfer') (simp add: higherPowers.rep_eq higherPoly0.rep_eq )

lemma monomials_lowerPoly: "monomials (lowerPoly b i mp) = higherPowers b i ` (monomials mp ∩ {x. ∀j∈{b..<b + i}. lookup x j = 0}) "
  by transfer' (simp add: keys_lowerPoly0)


lemma monomials_liftPoly: "monomials (liftPoly b i mp) = lowerPowers b i ` (monomials mp) "
  using keys_higherPoly0
  by (simp add: keys_higherPoly0 liftPoly.rep_eq monomials.rep_eq) 


value [code] "lowerPoly 1 1 (1 * Var 0 + 2 * Var 2 ^ 2 + 3 * Var 3 ^ 4::int mpoly) = (Var 0 + 2 * Var 1^2 + 3 * Var 2^4::int mpoly)"
value [code] "lowerPoly 1 3 (1 * Var 0 + 2 * Var 4 ^ 2 + 3 * Var 5 ^ 4::int mpoly) = (Var 0 + 2 * Var 1^2 + 3 * Var 2^4::int mpoly)"

value [code] "liftPoly 1 3 (1 * Var 0 + 2 * Var 4 ^ 2 + 3 * Var 5 ^ 4::int mpoly) = (Var 0 + 2 * Var 7^2 + 3 * Var 8^4::int mpoly)"

fun lowerAtom :: "nat ⇒ nat ⇒ atom ⇒ atom" where
  "lowerAtom d amount (Eq p) = Eq(lowerPoly d amount p)"|
  "lowerAtom d amount (Less p) = Less(lowerPoly d amount p)"|
  "lowerAtom d amount (Leq p) = Leq(lowerPoly d amount p)"|
  "lowerAtom d amount (Neq p) = Neq(lowerPoly d amount p)"

lemma lookup_not_in_vars_eq_zero: "x ∈ monomials p ⟹ i ∉ vars p ⟹ lookup x i = 0"
  by (meson degree_eq_iff varNotIn_degree)

lemma nth_dec_above:
  assumes "length xs = i" "length ys = j" "k ∉ {i..<i+j}"
  shows "nth_default 0 (xs @ zs) (dec_above i j k) = (nth_default 0 (xs @ ys @ zs)) k"
  using assms dec_above_def nth_append add.commute
  by (smt add_diff_cancel_left add_le_cancel_left add_strict_increasing append_Nil2 atLeastLessThan_iff le_add_diff_inverse length_append length_greater_0_conv less_imp_le_nat not_less nth_default_append)

lemma insertion_lowerPoly:
  assumes i_notin: "vars p ∩ {i..<i+j} = {}"
    and lprfx: "length prfx = i"
    and lxs: "length xs = j"
  shows "insertion (nth_default 0 (prfx@L)) (lowerPoly i j p) = insertion (nth_default 0 (prfx@xs@L)) p" (is "?lhs = ?rhs")
proof -
  have *: "monomials p ∩ {x. ∀j∈{i..<i + j}. lookup x j = 0} = monomials p"
    using assms(1) by (auto intro: lookup_not_in_vars_eq_zero)
  then have "monomials p ⊆ {x. ∀k. i ≤ k ∧ k < i + j ⟶ lookup x k = 0}"
    by force
  have "?lhs = (∑m∈monomials (lowerPoly i j p). MPoly_Type.coeff (lowerPoly i j p) m * (∏k∈keys m. (nth_default 0 (prfx @ L)) k ^ lookup m k))"
    unfolding insertion_code ..
  also have "… = (∑m∈monomials p.
       MPoly_Type.coeff p m * (∏k∈keys m. (nth_default 0 (prfx @ xs @ L) k) ^ lookup m k))"
  proof (rule sum.reindex_cong)
    note inj_on_higherPowers[of i j]
    moreover note ‹monomials p ⊆ _›
    ultimately show "inj_on (higherPowers i j) (monomials p)"
      by (rule inj_on_subset)
  next
    show "monomials (lowerPoly i j p) = higherPowers i j ` monomials p"
      unfolding monomials_lowerPoly * ..
  next
    fix m
    assume m: "m ∈ monomials p"
    from m ‹monomials p ⊆ _› have "keys m ⊆ {x. x ∉ {i..<i + j}}"
      by auto
    then have "lookup m k = 0" if "i ≤ k" "k < i + j" for k
      using that by (auto simp: in_keys_iff)
    then have "lowerPowers i j (higherPowers i j m) = m"
      by (rule lowerPowers_higherPowers)
    then have "MPoly_Type.coeff (lowerPoly i j p) (higherPowers i j m) = MPoly_Type.coeff p m"
      unfolding coeff_lowerPoly by simp
    moreover
    have "(∏k∈keys (higherPowers i j m). (nth_default 0 (prfx @ L)) k ^ lookup (higherPowers i j m) k) = 
      (∏k∈keys m. (nth_default 0 (prfx @ xs @ L)) k ^ lookup m k)"
    proof (rule prod.reindex_cong)
      show "keys (higherPowers i j m) = dec_above i j ` keys m"
        unfolding keys_higherPowers using ‹keys m ⊆ _› by auto
    next
      from inj_on_dec_above[of i j]
      show "inj_on (dec_above i j) (keys m)"
        by (rule inj_on_subset) (use ‹keys m ⊆ _› in auto)
    next
      fix k assume k: "k ∈ keys m"
      from k ‹keys m ⊆ _› have "k ∉ {i..<i+j}" by auto
      from k ‹keys m ⊆ _›
      have "inc_above i j (dec_above i j k) = k"
        by (subst inc_above_dec_above) auto
      then have "lookup (higherPowers i j m) (dec_above i j k) = lookup m k"
        unfolding higherPowers.rep_eq by simp
      moreover have "nth_default 0 (prfx @ L) (dec_above i j k) = (nth_default 0 (prfx @ xs @ L)) k"
        apply (rule nth_dec_above)
        using assms ‹k ∉ _›
        by auto
      ultimately
      show "((nth_default 0 (prfx @ L)) (dec_above i j k)) ^ lookup (higherPowers i j m) (dec_above i j k) = ((nth_default 0 (prfx @ xs @ L)) k) ^ lookup m k"
        by simp
    qed
    ultimately
    show "MPoly_Type.coeff (lowerPoly i j p) (higherPowers i j m) * (∏k∈keys (higherPowers i j m). (nth_default 0(prfx @ L)) k ^ lookup (higherPowers i j m) k) =
          MPoly_Type.coeff p m * (∏k∈keys m. (nth_default 0 (prfx @ xs @ L)) k ^ lookup m k)"
      by simp
  qed
  finally show ?thesis
    unfolding insertion_code .
qed

lemma insertion_lowerPoly1:
  assumes i_notin: "i ∉ vars p"
    and lprfx: "length prfx = i"
  shows "insertion (nth_default 0 (prfx@x#L)) p = insertion (nth_default 0 (prfx@L)) (lowerPoly i 1 p)"
  using assms nth_default_def apply simp
  by (subst insertion_lowerPoly[where xs="[x]"]) auto

lemma insertion_lowerPoly01:
  assumes i_notin: "0 ∉ vars p"
  shows "insertion (nth_default 0 (x#L)) p = insertion (nth_default 0 L) (lowerPoly 0 1 p)"
  using insertion_lowerPoly1[OF assms, of Nil x L]
  by simp

lemma aEval_lowerAtom : "(freeIn 0 (Atom A)) ⟹ (aEval A (x#L) = aEval (lowerAtom 0 1 A) L)"
  by (cases A) (simp_all add:insertion_lowerPoly01)


fun map_fm_binders :: "(atom ⇒ nat ⇒ atom) ⇒ atom fm ⇒ nat ⇒ atom fm" where
  "map_fm_binders f TrueF n = TrueF"|
  "map_fm_binders f FalseF n = FalseF"|
  "map_fm_binders f (Atom φ) n = Atom (f φ n)"|
  "map_fm_binders f (And φ ψ) n = And (map_fm_binders f φ n) (map_fm_binders f ψ n)"|
  "map_fm_binders f (Or φ ψ) n = Or (map_fm_binders f φ n) (map_fm_binders f ψ n)"|
  "map_fm_binders f (ExQ φ) n = ExQ(map_fm_binders f φ (n+1))"|
  "map_fm_binders f (AllQ φ) n = AllQ(map_fm_binders f φ (n+1))"|
  "map_fm_binders f (AllN i φ) n = AllN i (map_fm_binders f φ (n+i))"|
  "map_fm_binders f (ExN i φ) n = ExN i (map_fm_binders f φ (n+i))"|
  "map_fm_binders f (Neg φ) n = Neg(map_fm_binders f φ n)"



fun lowerFm :: "nat ⇒ nat ⇒ atom fm ⇒ atom fm" where
  "lowerFm d amount f = map_fm_binders (λa. λx. lowerAtom (d+x) amount a) f 0"

fun delete_nth :: "nat ⇒ real list ⇒ real list" where
  "delete_nth n xs = take n xs @ drop n xs"

lemma eval_lowerFm_helper :
  assumes "freeIn i F"
  assumes "length init = i"
  shows "eval (lowerFm i 1 F) (init @xs) = eval F (init@[x]@xs)"
  using assms
proof(induction F arbitrary : i init)
  case TrueF
  then show ?case by simp
next
  case FalseF
  then show ?case by simp
next
  case (Atom A)
  then show ?case apply(cases A) by (simp_all add: insertion_lowerPoly1)
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)
  then show ?case by auto
next
  case (Neg F)
  then show ?case by simp
next
  case (ExQ F)
  have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + 1)) = (map_fm_binders (λa x. lowerAtom (i + 1 + x) 1 a) F y)"
    apply(induction F) by(simp_all)
  show ?case apply simp apply(rule ex_cong1)
    subgoal for xa
      using map[of 0] ExQ(1)[of "Suc i" "xa#init"] ExQ(2) ExQ(3)
      by simp
    done
next
  case (AllQ F)
  have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + 1)) = (map_fm_binders (λa x. lowerAtom (i + 1 + x) 1 a) F y)"
    apply(induction F) by(simp_all)
  show ?case apply simp apply(rule all_cong1)
    subgoal for xa
      using map[of 0] AllQ(1)[of "Suc i" "xa#init"] AllQ(2) AllQ(3)
      by simp
    done
next
  case (ExN x1 F)
  have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + x1)) = (map_fm_binders (λa x. lowerAtom (i + x1 + x) 1 a) F y)"
    apply(induction F) apply(simp_all add:add.commute add.left_commute)
    apply (metis add_Suc)
    apply (metis add_Suc)
    apply (metis add.assoc)
    by (metis add.assoc)
  show ?case apply simp apply(rule ex_cong1)
    subgoal for l
      using map[of 0] ExN(1)[of "i+x1" "l@init"] ExN(2) ExN(3)
      by auto
    done
next
  case (AllN x1 F)
  have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + x1)) = (map_fm_binders (λa x. lowerAtom (i + x1 + x) 1 a) F y)"
    apply(induction F) apply(simp_all add:add.commute add.left_commute)
    apply (metis add_Suc)
    apply (metis add_Suc)
    apply (metis add.assoc)
    by (metis add.assoc)
  show ?case apply simp apply(rule all_cong1)
    subgoal for l
      using map[of 0] AllN(1)[of "i+x1" "l@init"] AllN(2) AllN(3)
      by auto
    done
qed

lemma eval_lowerFm :
  assumes h : "freeIn 0 F"
  shows " ∀xs. (eval (lowerFm 0 1 F) xs = eval (ExQ F) xs)"
  using eval_lowerFm_helper[OF h] by simp

fun liftAtom :: "nat ⇒ nat ⇒ atom ⇒ atom" where
  "liftAtom d amount (Eq p) = Eq(liftPoly d amount p)"|
  "liftAtom d amount (Less p) = Less(liftPoly d amount p)"|
  "liftAtom d amount (Leq p) = Leq(liftPoly d amount p)"|
  "liftAtom d amount (Neq p) = Neq(liftPoly d amount p)"


fun liftFm :: "nat ⇒ nat ⇒ atom fm ⇒ atom fm" where
  "liftFm d amount f = map_fm_binders (λa. λx. liftAtom (d+x) amount a) f 0"

fun insert_into :: "real list ⇒ nat ⇒ real list ⇒ real list" where
  "insert_into xs n l = take n xs @ l @ drop n xs"


lemma higherPoly0_add : "higherPoly0 x y (p + q) = higherPoly0 x y p + higherPoly0 x y q"
  using poly_mapping_eq_iff[where a = "higherPoly0 x y (p + q)", where b = "higherPoly0 x y p + higherPoly0 x y q"]
    plus_poly_mapping.rep_eq[where x = "higherPoly0 x y (p + q)", where xa = "higherPoly0 x y p + higherPoly0 x y q"]
  apply (auto) 
  by (simp add: higherPoly0.rep_eq lookup_add poly_mapping_eqI)   

lemma liftPoly_add: "liftPoly w z (a + b) = (liftPoly w z a) + (liftPoly w z b)"
  unfolding liftPoly_def apply (auto)
proof - 
  have h1: "mapping_of (a + b) = mapping_of a + mapping_of b"
    by (simp add: plus_mpoly.rep_eq) 
  have h2: "MPoly (higherPoly0 w z (mapping_of a + mapping_of b)) = 
    MPoly (higherPoly0 w z (mapping_of a)) + MPoly (higherPoly0 w z (mapping_of b))"
  proof - 
    have h0a: "higherPoly0 w z (mapping_of a + mapping_of b) = (higherPoly0 w z (mapping_of a)) + (higherPoly0 w z (mapping_of b))"
      using higherPoly0_add[of w z _ _ ] by auto  
    then show ?thesis
      by (simp add: plus_mpoly.abs_eq) 
  qed
  show "MPoly (higherPoly0 w z (mapping_of (a + b))) =
    MPoly (higherPoly0 w z (mapping_of a)) +
    MPoly (higherPoly0 w z (mapping_of b))" using h1 h2 by auto    
qed


lemma vars_lift_add : "vars(liftPoly a b (p+q)) ⊆ vars(liftPoly a b (p))∪ vars(liftPoly a b (q))"
  using liftPoly_add[of a b p q]
  using vars_add[of "liftPoly a b p" "liftPoly a b q"]
  by auto

lemma mapping_of_lift_add : "mapping_of (liftPoly x y (a + b)) = mapping_of (liftPoly x y a) + mapping_of (liftPoly x y b)"
  unfolding liftPoly.rep_eq plus_mpoly.rep_eq
  using higherPoly0_add .

lemma coeff_lift_add : "MPoly_Type.coeff (liftPoly x y (a + b)) m = MPoly_Type.coeff (liftPoly x y a) m + MPoly_Type.coeff (liftPoly x y b) m"
proof-
  have "MPoly_Type.coeff (liftPoly x y (a + b)) m = MPoly_Type.coeff (liftPoly x y a + liftPoly x y b) m"
    apply( simp add : mapping_of_lift_add coeff_def  ) using lookup_add
    by (simp add: plus_mpoly.rep_eq) 
  also have "... = MPoly_Type.coeff (liftPoly x y a) m + MPoly_Type.coeff (liftPoly x y b) m"
    using MPolyExtension.coeff_add[of "liftPoly x y a" "liftPoly x y b" m]  .
  finally show ?thesis
    by auto
qed

lemma lift_add : "insertion (f::nat⇒real)  (liftPoly 0 z (a + b)) = insertion f (liftPoly 0 z a + liftPoly 0 z b)"
  using liftPoly_add[of 0 z a b]
  by simp

lemma lower_power_zero : "lowerPowers a b 0 = 0"
  unfolding lowerPowers_def dec_above_def id_def apply auto
  unfolding Poly_Mapping.lookup_zero by auto

lemma lift_vars_monom : "vars (liftPoly i j ((MPoly_Type.monom m a)::real mpoly)) = (λx. if x≥i then x+j else x) ` vars(MPoly_Type.monom m a)" 
proof(cases "a=0")
  case True
  then show ?thesis
    by (smt MPolyExtension.monom_zero add.left_neutral add_diff_cancel_right' image_empty liftPoly_add vars_monom_single_cases)
next
  case False
  have h1: "vars (liftPoly i j (MPoly_Type.monom m a)) = keys (lowerPowers i j m)"
    unfolding liftPoly_def
    unfolding keys_lowerPowers keys_higherPoly0 vars_def apply auto
    apply (smt imageE keys_higherPoly0 keys_lowerPowers lookup_eq_zero_in_keys_contradict lookup_single_not_eq mapping_of_inverse monomials.abs_eq)
    by (metis False higherPowers.rep_eq higherPowers_lowerPowers image_eqI in_keys_iff keys_higherPoly0 lookup_single_eq mapping_of_inverse monomials.abs_eq)
  show ?thesis
    unfolding h1  vars_monom_keys[OF False]
      keys_lowerPowers inc_above_def by auto
qed

lemma lift_clear_vars : "vars (liftPoly i j (p::real mpoly)) ∩ {i..<i + j} = {}"
proof(induction p rule: mpoly_induct)
  case (monom m a)
  then show ?case
    unfolding lift_vars_monom by auto
next
  case (sum p1 p2 m a)
  then show ?case
    using vars_lift_add[of i j p1 p2]
    by blast 
qed

lemma lift0: "(liftPoly i j 0) = 0"
  by (simp add: coeff_liftPoly mpoly_eq_iff)

lemma lower0: "(lowerPoly i j 0) = 0"
  by (simp add: coeff_all_0 coeff_lowerPoly)

lemma lower_lift_monom : "insertion f (MPoly_Type.monom m a :: real mpoly) = insertion f (lowerPoly i j (liftPoly i j (MPoly_Type.monom  m a)))"
proof (cases "a=0")
  case True
  show ?thesis unfolding True lift0 monom_zero lower0 ..
next
  case False
  have h1 :  "higherPowers i j ` ({lowerPowers i j m} ∩ {x. ∀j∈{i..<i + j}. lookup x j = 0}) = {m}"
    apply (simp add: lowerPowers.rep_eq higherPowers.rep_eq)
    using higherPowers_lowerPowers .
  have higher_lower : "higherPowers i j (lowerPowers i j m) = m"
    using higherPowers_lowerPowers by blast 
  show ?thesis using False
    unfolding insertion_code monomials_monom apply auto
    unfolding monomials_lowerPoly monomials_liftPoly apply auto
    unfolding More_MPoly_Type.coeff_monom  h1 apply auto
    unfolding coeff_lowerPoly coeff_liftPoly higherPowers_lowerPowers coeff_monom
    apply(cases "∃ja∈{i..<i + j}. 0 < lookup (lowerPowers i j m) ja")
    apply auto
    by (simp add: lowerPowers_eq)
qed 


lemma lower_lift : "insertion f (p::real mpoly) = insertion f (lowerPoly i j (liftPoly i j p))"
  unfolding insertion_code proof(induction p rule: mpoly_induct)
  case (monom m a)
  then show ?case using lower_lift_monom unfolding insertion_code monomials_lowerPoly monomials_liftPoly coeff_lowerPoly coeff_liftPoly by auto
next
  case (sum p1 p2 m a)
  have h1 : "monomials p1 ∩ monomials p2 = {}" using sum
    by (metis Int_insert_right_if0 inf_bot_right monomials_monom)
  have h4 : "monomials (lowerPoly i j (liftPoly i j (p1 + p2))) = monomials (lowerPoly i j (liftPoly i j (p1))) ∪ monomials (lowerPoly i j (liftPoly i j (p2)))"
    using monomials_lowerPoly monomials_liftPoly monomials_add_disjoint[OF h1]
    by (simp add: monomials_liftPoly monomials_lowerPoly Int_Un_distrib2 image_Un)
  have h5 : "MPoly_Type.coeff (lowerPoly i j (liftPoly i j (p1 + p2))) = MPoly_Type.coeff (lowerPoly i j (liftPoly i j (p1))) + MPoly_Type.coeff (lowerPoly i j (liftPoly i j (p2)))"
    unfolding coeff_lowerPoly coeff_liftPoly MPolyExtension.coeff_add by auto
  show ?case
    unfolding MPolyExtension.coeff_add
    unfolding h4 h5
    unfolding monomials_add_disjoint[OF h1]
    by (smt IntE coeff_eq_zero_iff disjoint_iff_not_equal finite_monomials h1 higherPowers_lowerPowers imageE monomials_liftPoly monomials_lowerPoly plus_fun_apply sum.IH(1) sum.IH(2) sum.cong sum.union_disjoint
        )
qed
lemma lift_insertion : " ∀init.
       length init = (i::nat) ⟶
       (∀I xs.
           (insertion (nth_default 0 (init @ xs)) (p::real mpoly)) = (insertion ((nth_default 0) (init @ I @ xs)) (liftPoly i (length I) p)))"
proof safe
  fix init I xs
  assume "i = length (init::real list)"
  then have i_len : "length init = i" by auto
  have h: "higherPoly0 i (length (I::real list)) (mapping_of p) ∈ UNIV"
    by simp
  have h2 : "vars (liftPoly i (length I) p) ∩ {i..<i + length I} = {}"
    using lift_clear_vars by auto
  show "insertion ((nth_default 0) (init @ xs)) p = insertion ((nth_default 0) (init @ I @ xs)) (liftPoly (length init) (length I) p) "
    using lower_lift insertion_lowerPoly[OF h2 i_len refl, of xs] i_len by auto
qed

lemma eval_liftFm_helper :
  assumes "length init = i"
  assumes "length I = amount"
  shows "eval F (init @xs) = eval (liftFm i amount F) (init@I@xs)"
  using assms(1)
proof(induction F arbitrary: i init)
  case (Atom x)
  then show ?case
    apply(cases x) apply simp_all using lift_insertion assms Atom.prems by force+
next
  case (ExQ F)
  have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + Suc 0)) = (map_fm_binders (λa x. liftAtom (i + 1 + x) amount a) F y)"
    apply(induction F) by(simp_all)
  show ?case apply simp apply(rule ex_cong1)
    subgoal for x
      using map[of 0] using ExQ(1)[of "x#init" "i+1"] ExQ(2)
      by simp
    done
next
  case (AllQ F)
  have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + Suc 0)) = (map_fm_binders (λa x. liftAtom (i + 1 + x) amount a) F y)"
    apply(induction F) by(simp_all)
  show ?case apply simp apply(rule all_cong1)
    subgoal for x
      using map[of 0] using AllQ(1)[of "x#init" "i+1"] AllQ(2)
      by simp
    done
next
  case (ExN x1 F)
  have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + x1)) = (map_fm_binders (λa x. liftAtom (i + x1 + x) amount a) F y)"
    apply(induction F) apply(simp_all add: add.commute add.left_commute)
    apply (metis add_Suc)
    apply (metis add_Suc)
    apply (metis add.assoc)
    by (metis add.assoc)
  show ?case apply simp apply(rule ex_cong1)
    subgoal for l
      using map[of 0] ExN(1)[of "l@init" "i+x1"] ExN(2)
      by auto
    done
next
  case (AllN x1 F)
  have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + x1)) = (map_fm_binders (λa x. liftAtom (i + x1 + x) amount a) F y)"
    apply(induction F) apply(simp_all add: add.commute add.left_commute)
    apply (metis add_Suc)
    apply (metis add_Suc)
    apply (metis add.assoc)
    by (metis add.assoc)
  show ?case apply simp apply(rule all_cong1)
    subgoal for l
      using map[of 0] AllN(1)[of "l@init" "i+x1"] AllN(2)
      by auto
    done
qed auto

lemma eval_liftFm :
  assumes "length I = amount"
  assumes "length L ≥ d"
  shows "eval F L = eval (liftFm d amount F) (insert_into L d I)"
proof -
  define init where "init = take d L"
  then have "length init = d" using assms by simp
  then have "(eval F (init @ (drop d L)) = eval (liftFm d amount F) (init @ I @ (drop d L)))"
    using eval_liftFm_helper[of init d I amount  F "(drop d L)"] assms by auto
  then show ?thesis
    unfolding insert_into.simps assms init_def by auto
qed


lemma not_in_lift : "var∉vars(p::real mpoly) ⟹ var+z∉vars(liftPoly 0 z p)"
proof(induction p rule: mpoly_induct)
  case (monom m a)
  then show ?case 
    using lift_vars_monom[of 0 z m a] by auto
next
  case (sum p1 p2 m a)
  show ?case 
    using sum using vars_lift_add[of 0 z p1 p2]
      vars_add[of p1 p2]
    by (metis (no_types, lifting) Set.basic_monos(7) Un_iff monomials.rep_eq vars_add_monom)
qed

lemma lift_const : "insertion f (liftPoly 0 z (Const (C::real))) = insertion f (Const C :: real mpoly)"
  apply(cases "C=0")
  unfolding insertion_code monomials_Const coeff_Const monomials_liftPoly  apply auto
  unfolding lower_power_zero[of 0 z] lookup_zero power.power_0 comm_monoid_mult_class.prod.neutral_const coeff_liftPoly coeff_Const
  unfolding higherPowers_def by auto

lemma liftPoly_sub: "liftPoly 0 z (a - b) = (liftPoly 0 z a) - (liftPoly 0 z b)"
  unfolding liftPoly_def apply (auto)
proof - 
  have h1: "mapping_of (a - b) = mapping_of a - mapping_of b"
    by (simp add: minus_mpoly.rep_eq) 
  have h2: "MPoly (higherPoly0 0 z (mapping_of a - mapping_of b)) = 
    MPoly (higherPoly0 0 z (mapping_of a)) - MPoly (higherPoly0 0 z (mapping_of b))"
  proof - 
    have h0a: "higherPoly0 0 z (mapping_of a - mapping_of b) = (higherPoly0 0 z (mapping_of a)) - (higherPoly0 0 z (mapping_of b))"
      using poly_mapping_eq_iff[where a = "higherPoly0 0 z (mapping_of a - mapping_of b)", where b = "(higherPoly0 0 z (mapping_of a)) - (higherPoly0 0 z (mapping_of b))"]
        minus_poly_mapping.rep_eq[where x = "higherPoly0 0 z (mapping_of a - mapping_of b)", where xa = "(higherPoly0 0 z (mapping_of a)) - (higherPoly0 0 z (mapping_of b))"]
      apply (auto) 
      by (simp add: higherPoly0.rep_eq poly_mapping_eqI minus_poly_mapping.rep_eq)
    then show ?thesis
      by (simp add: minus_mpoly.abs_eq) 
  qed
  show "MPoly (higherPoly0 0 z (mapping_of (a - b))) =
    MPoly (higherPoly0 0 z (mapping_of a)) -
    MPoly (higherPoly0 0 z (mapping_of b))" using h1 h2 by auto    
qed

lemma lift_sub : "insertion (f::nat⇒real) (liftPoly 0 z (a - b)) = insertion f (liftPoly 0 z a - liftPoly 0 z b)"
  using liftPoly_sub[of "z" "a" "b"] by auto

lemma lift_minus : 
  assumes "insertion (f::nat ⇒ real) (liftPoly 0 z (c - Const (C::real))) = 0"
  shows "insertion f (liftPoly 0 z c) = C"
proof-
  have "insertion f (liftPoly 0 z (c - Const C)) = insertion f ((liftPoly 0 z c) - (liftPoly 0 z (Const C)))"
    by (simp add: lift_sub) 
  have "... = insertion f (liftPoly 0 z c) - (insertion f (liftPoly 0 z (Const C)))"
    using insertion_sub by auto
  also have "... = insertion f (liftPoly 0 z c) - C"
    using lift_const[of f z C] insertion_const by auto
  then show ?thesis
    using ‹insertion f (liftPoly 0 z (c - Const C)) = insertion f (liftPoly 0 z c - liftPoly 0 z (Const C))› assms calculation by auto
qed

end

lemma lift00 : "liftPoly 0 0 (a::real mpoly) = a"
  unfolding liftPoly_def apply auto
  unfolding higherPoly0_def apply auto
  unfolding higherPowers_def apply auto
  by (simp add: mapping_of_inverse)

end

Theory Reindex

subsection "Swapping Indicies"
theory Reindex
  imports Debruijn
begin

context includes poly_mapping.lifting begin

definition "swap i j x = (if x = i then j else if x = j then i else x)"

lemma swap_swap : "swap i j (swap i j x) = x"
  unfolding swap_def by auto


lemma finite_swap_ne: "finite {x. f x ≠ c} ⟹ finite {x. f (swap b i x) ≠ c}"
proof - 
  assume finset: "finite {x. f x ≠ c}"
  let ?A = "{x. f x ≠ c}"
  let ?B = "{x. f (swap b i x) ≠ c}"
  have finsubset: "finite (?A - {i, b})" using finset by auto
  have sames: "(?A - {i, b}) = (?B - {i, b})"
    unfolding swap_def by auto
  then have "finite (?B - {i, b})" 
    using finsubset by auto
  then have finBset: "finite ((?B - {i, b}) ∪ {i, b})" by auto
  then have "?B ⊆ ((?B - {i, b}) ∪ {i, b})" by auto
  then show ?thesis using finBset by auto
qed

lift_definition swap0::"nat ⇒ nat ⇒ (nat ⇒0 'a) ⇒ (nat ⇒0 'a::zero)"
  is "λb i p x. p (swap b i x)::'a"
proof -
  fix b i::nat and p::"nat ⇒ 'a"
  assume "finite {x. p x ≠ 0}"
  then have "finite {x. p (swap b i x) ≠ 0}"
    by (rule finite_swap_ne)
  from _ this show "finite {x. p (swap b i x)  ≠ 0}"
    by (rule finite_subset) auto
qed

lemma swap0_swap0: "swap0 n i (swap0 n i x) = x"
  by transfer (force simp: swap_def)

lemma inj_swap: "inj (swap b i)"
  using swap_swap
  by (rule inj_on_inverseI)

lemma inj_swap0: "inj (swap0 b i)"
  using swap0_swap0
  by (rule inj_on_inverseI)


lemma swap0_eq: "lookup (swap0 b i p) x = lookup p (swap b i x)"
  by (simp_all add: swap0.rep_eq)

lemma eq_onp_swap : "eq_onp (λf. finite {x. f x ≠ 0}) (λx. lookup m (swap b i x))
   (λx. lookup m (swap b i x))"
  unfolding eq_onp_def apply simp
  apply(rule finite_swap_ne)
  by auto

lemma keys_swap: "keys (swap0 b i m) = swap b i ` keys m"  
  apply safe
  subgoal for x
    unfolding swap0_def apply simp
    unfolding keys.abs_eq[OF eq_onp_swap]
    by (metis (mono_tags, lifting) Reindex.swap_swap image_eqI lookupNotIn mem_Collect_eq)
  subgoal for x y
    unfolding swap0_def apply simp
    unfolding keys.abs_eq[OF eq_onp_swap]
    by (metis (mono_tags, lifting) Reindex.swap_swap lookup_eq_zero_in_keys_contradict mem_Collect_eq)
  done


context includes fmap.lifting begin

lift_definition swapf::"nat ⇒ nat ⇒ (nat, 'a) fmap ⇒ (nat, 'a::zero) fmap"
  is "λb i p x. p (swap b i x)"
proof -
  fix b i::nat and p::"nat ⇒ 'a option"
  assume "finite (dom p)"
  then have "finite {x. p x ≠ None}" by (simp add: dom_def)

  have "dom (λx. p (swap b i x)) = {x. p (swap b i x) ≠ None}"
    by auto
  also have "finite …"
    by (rule finite_swap_ne) fact
  finally
  have "finite (dom (λx. p (swap b i x)))" .
  from _ this
  show "finite (dom (λx. p (swap b i x)))"
    by (rule finite_subset) (auto split: if_splits)
qed


lemma compute_swapf[code]: "swapf b i (fmap_of_list xs) =
  fmap_of_list (map (λ(k, v). (swap b i k, v)) xs)"
proof -
  have *: "map_of (map (λ(k, y). (swap b i k, y)) (xs)) x =
    map_of xs (swap b i x)"
    for x
    apply (rule map_of_map_key_inverse_fun_eq)
    unfolding swap_swap by auto
  show ?thesis
    unfolding swapf_def apply simp
    unfolding fmlookup_of_list
    unfolding Finite_Map.fmap_of_list.abs_eq
    using map_of_map_key_inverse_fun_eq[where f="swap b i", where g="swap b i", where xs=xs]
    unfolding swap_swap
    apply simp
    by presburger
qed

lemma compute_swap[code]: "swap0 n i (Pm_fmap xs) = Pm_fmap (swapf n i xs)"
  apply(rule poly_mapping_eqI)
  by  (auto simp: swapf.rep_eq swap0.rep_eq fmlookup_default_def swap_def
      split: option.splits)

lift_definition swapPoly0::"nat ⇒ nat ⇒ ((nat⇒0nat)⇒0'a::zero) ⇒ ((nat⇒0nat)⇒0 'a)" is
  "λb i (mp::(nat⇒0nat)⇒'a) mon. mp (swap0 b i mon)"
proof -
  fix b i and mp::"(nat ⇒0 nat) ⇒ 'a"
  assume "finite {x. mp x ≠ 0}"
  have "{x. mp (swap0 b i x) ≠ 0} = (swap0 b i -` {x. mp x ≠ 0})"
    (is "?set = ?vimage")
    by auto
  also 
  from finite_vimageI[OF ‹finite _› inj_swap0]
  have "finite ?vimage" .
  finally show "finite ?set" .
qed

lemma swap_zero[simp]: "swap0 b i 0 = 0"
  by transfer auto


context includes fmap.lifting begin

lift_definition swapPolyf::"nat ⇒ nat ⇒ ((nat⇒0nat), 'a::zero)fmap ⇒ ((nat⇒0nat), 'a)fmap" is
  "λb i (mp::((nat⇒0nat)⇀'a)) mon::(nat⇒0nat). mp (swap0 b i mon)"
proof -― ‹TODO: this is exactly the same proof as the one for ‹lowerPoly0››
  fix b i and mp::"(nat ⇒0 nat) ⇒ 'a option"
  assume "finite (dom mp)"
  also have "dom mp = {x. mp x ≠ None}" by auto
  finally have "finite {x. mp x ≠ None}" .
  have "(dom (λmon. mp (swap0 b i mon))) = {mon. mp (swap0 b i mon) ≠ None}"
    (is "?set = _")
    by (auto split: if_splits)
  also have "… = swap0 b i -` {x. mp x ≠ None}" (is "_ = ?vimage")
    by auto
  also
  from finite_vimageI[OF ‹finite {x. mp x ≠ None}› inj_swap0]
  have "finite ?vimage" .
  finally show "finite ?set" .
qed


lemma keys_swap0: "keys (swapPoly0 b i mp) = swap0 b i ` (keys mp)"
  apply (auto )
  subgoal for x
    apply (rule image_eqI[where x="swap0 b i x"])
    by (auto simp: swap0_swap0 in_keys_iff swapPoly0.rep_eq)
  subgoal for x
    apply (auto simp: in_keys_iff swapPoly0.rep_eq)
    by (simp add: swap0_swap0)
  done

end

lemma compute_swapPoly0[code]: "swapPoly0 n i (Pm_fmap m) = Pm_fmap (swapPolyf n i m)"
  by (auto simp: swapPoly0.rep_eq fmlookup_default_def swapPolyf.rep_eq
      split: option.splits
      intro!: poly_mapping_eqI)

lemma compute_swapPolyf[code]: "swapPolyf n i (fmap_of_list xs) =
  (fmap_of_list (map (λ(mon, c). (swap0 n i mon, c))
    xs))"
  apply (rule sym)
  apply (rule fmap_ext)
  unfolding swapPolyf.rep_eq fmlookup_of_list
  apply (subst map_of_map_key_inverse_fun_eq[where g="swap0 n i"])
  unfolding swap0_swap0 by auto

end
end

lift_definition swap_poly::"nat ⇒ nat ⇒ 'a::zero mpoly ⇒ 'a mpoly" is swapPoly0 .

value "swap_poly 0 1 (Var 0 :: real mpoly)"

lemma coeff_swap_poly: "MPoly_Type.coeff (swap_poly b i mp) x = MPoly_Type.coeff mp (swap0 b i x)"
  by (transfer') (simp add: swapPoly0.rep_eq)

lemma monomials_swap_poly: "monomials (swap_poly b i mp) = swap0 b i ` (monomials mp) "
  by transfer' (simp add: keys_swap0)

fun swap_atom :: "nat ⇒ nat ⇒ atom ⇒ atom" where
  "swap_atom a b (Eq p) = Eq (swap_poly a b p)"|
  "swap_atom a b (Less p) = Less (swap_poly a b p)"|
  "swap_atom a b (Leq p) = Leq (swap_poly a b p)"|
  "swap_atom a b (Neq p) = Neq (swap_poly a b p)"

fun swap_fm :: "nat ⇒ nat ⇒ atom fm ⇒ atom fm" where
  "swap_fm a b TrueF = TrueF"|
  "swap_fm a b FalseF = FalseF"|
  "swap_fm a b (Atom At) = Atom(swap_atom a b At)"|
  "swap_fm a b (And A B) = And(swap_fm a b A)(swap_fm a b B)"|
  "swap_fm a b (Or A B) = Or(swap_fm a b A)(swap_fm a b B)"|
  "swap_fm a b (Neg A) = Neg(swap_fm a b A)"|
  "swap_fm a b (ExQ A) = ExQ(swap_fm (a+1) (b+1) A)"|
  "swap_fm a b (AllQ A) = AllQ(swap_fm (a+1) (b+1) A)"|
  "swap_fm a b (ExN i A) = ExN i (swap_fm (a+i) (b+i) A)"|
  "swap_fm a b (AllN i A) = AllN i (swap_fm (a+i) (b+i) A)"

fun swap_list :: "nat ⇒ nat ⇒ 'a list ⇒ 'a list"where
  "swap_list i j l = l[j := nth l i, i := nth l j]"

lemma swap_list_cons: "swap_list (Suc a) (Suc b) (x # L) = x # swap_list a b L"
  by auto

lemma inj_on : "inj_on (swap0 a b) (monomials p)"
  unfolding inj_on_def
  by (metis swap0_swap0) 

lemma inj_on' : "inj_on (swap a b) (keys m)"
  unfolding inj_on_def
  by (meson Reindex.inj_swap injD)

lemma swap_list : 
  assumes  "a < length L"
  assumes "b < length L"
  shows "nth_default 0 (L[b := L ! a, a := L ! b]) (swap a b xa) = nth_default 0 L xa"
  using assms unfolding swap_def apply auto
  apply (simp_all add: nth_default_nth)
  by (simp add: nth_default_def)

lemma swap_poly : 
  assumes "length L > a"
  assumes "length L > b"
  shows "insertion (nth_default 0 L) p = insertion (nth_default 0 (swap_list a b L)) (swap_poly a b p)"
  unfolding insertion_code apply auto
  unfolding monomials.abs_eq 
  unfolding coeff_swap_poly monomials_swap_poly apply auto
  unfolding Groups_Big.comm_monoid_add_class.sum.reindex[OF inj_on] apply simp
  unfolding swap0_swap0
  unfolding keys_swap
  unfolding Groups_Big.comm_monoid_mult_class.prod.reindex[OF inj_on']
  apply simp 
  unfolding swap0_eq swap_swap swap_list[OF assms] by auto

lemma swap_fm :
  assumes "length L > a"
  assumes "length L > b"
  shows "eval F L = eval (swap_fm a b F) (swap_list a b L)"
  using assms proof(induction F arbitrary: a b L)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom At)
  then show ?case apply(cases At) using swap_poly[OF Atom(1) Atom(2)] by auto
next
  case (And F1 F2)
  show ?case using And(1)[OF And(3-4)] And(2)[OF And(3-4)] by auto
next
  case (Or F1 F2)
  then show ?case using Or(1)[OF Or(3-4)] Or(2)[OF Or(3-4)] by auto
next
  case (Neg F)
  then show ?case using Neg(1)[OF Neg(2-3)] by auto
next
  case (ExQ F)
  show ?case apply simp 
    apply(rule ex_cong1)
    subgoal for x
      using ExQ(1)[of "Suc a" "x#L" "Suc b"] unfolding swap_list_cons using ExQ(2-3) by simp
    done
next
  case (AllQ F)
  then show ?case apply simp 
    apply(rule all_cong1)
    subgoal for x
      using AllQ(1)[of "Suc a" "x#L" "Suc b"] unfolding swap_list_cons using AllQ(2-3) by simp
    done
next
  case (ExN i F)
  show ?case
    apply simp
    apply(rule ex_cong1)
    subgoal for l
      using ExN(1)[of "a+i" "l@L" "b+i"]
      by (smt (verit, del_insts) ExN.prems(1) ExN.prems(2) add.commute add_diff_cancel_right' add_less_cancel_left length_append list_update_append not_add_less2 nth_append swap_list.elims) 
    done
next
  case (AllN i F)
  then show ?case
    apply simp apply(rule all_cong1)
    by (smt (z3) add.commute add_diff_cancel_right' le_add2 length_append less_diff_conv2 list_update_append not_add_less2 nth_append)
qed

lemma "eval (ExQ (ExQ F)) L = eval (ExQ (ExQ (swap_fm 0 1 F))) L"
  apply simp
  apply safe
  subgoal for i j
    apply(rule exI[where x=j])
    apply(rule exI[where x=i])
    using swap_fm[of 0 "j # i # L" "Suc 0" F]
    by simp
  subgoal for i j
    apply(rule exI[where x=j])
    apply(rule exI[where x=i])
    using swap_fm[of 0 "i # j # L" "Suc 0" F]
    by simp
  done

lemma swap_atom:
  assumes "length L > a"
  assumes "length L > b"
  shows "aEval F L = aEval (swap_atom a b F) (swap_list a b L)"
  using swap_fm[OF assms, of "Atom F"] by auto
end

Theory Optimizations

section "Optimizations"
theory Optimizations
  imports Debruijn
begin

text "Does negation normal form conversion"
fun nnf :: "atom fm ⇒ atom fm" where
  "nnf TrueF = TrueF" |
  "nnf FalseF = FalseF " |
  "nnf (Atom a) = Atom a" |
  "nnf (And φ1 φ2) = And (nnf φ1) (nnf φ2)" |
  "nnf (Or φ1 φ2) = Or (nnf φ1) (nnf φ2)" |
  "nnf (ExQ φ) = ExQ (nnf φ)" |
  "nnf (AllQ φ) = AllQ (nnf φ)"|
  "nnf (AllN i φ) = AllN i (nnf φ)"|
  "nnf (ExN i φ) = ExN i (nnf φ)" |
  "nnf (Neg TrueF) = FalseF" |
  "nnf (Neg FalseF) = TrueF" |
  "nnf (Neg (Neg φ)) = (nnf φ)" |
  "nnf (Neg (And φ1 φ2)) = (Or (nnf (Neg φ1)) (nnf (Neg φ2)))" |
  "nnf (Neg (Or φ1 φ2)) = (And (nnf (Neg φ1)) (nnf (Neg φ2)))" |
  "nnf (Neg (Atom a)) = Atom(aNeg a)" |
  "nnf (Neg (ExQ φ)) = AllQ (nnf (Neg φ))" |
  "nnf (Neg (AllQ φ)) = ExQ (nnf (Neg φ))"|
  "nnf (Neg (AllN i φ)) = ExN i (nnf (Neg φ))"|
  "nnf (Neg (ExN i φ)) = AllN i (nnf (Neg φ))"


subsection "Simplify Constants"

fun simp_atom :: "atom ⇒ atom fm" where
  "simp_atom (Eq p)   = (case get_if_const p of None ⇒ Atom(Eq   p) | Some(r) ⇒ (if r=0 then TrueF else FalseF))"|
  "simp_atom (Less p) = (case get_if_const p of None ⇒ Atom(Less p) | Some(r) ⇒ (if r<0 then TrueF else FalseF))"|
  "simp_atom (Leq p)  = (case get_if_const p of None ⇒ Atom(Leq  p) | Some(r) ⇒ (if r≤0 then TrueF else FalseF))"|
  "simp_atom (Neq p)  = (case get_if_const p of None ⇒ Atom(Neq  p) | Some(r) ⇒ (if r≠0 then TrueF else FalseF))"

fun simpfm :: "atom fm ⇒ atom fm" where
  "simpfm TrueF = TrueF"|
  "simpfm FalseF = FalseF"|
  "simpfm (Atom a) = simp_atom a"|
  "simpfm (And φ ψ) = and (simpfm φ) (simpfm ψ)"|
  "simpfm (Or φ ψ) = or (simpfm φ) (simpfm ψ)"|
  "simpfm (ExQ φ) = ExQ (simpfm φ)"|
  "simpfm (Neg φ) = neg (simpfm φ)"|
  "simpfm (AllQ φ) = AllQ(simpfm φ)"|
  "simpfm (AllN i φ) = AllN i (simpfm φ)"|
  "simpfm (ExN i φ) = ExN i (simpfm φ)"


subsection "Group Quantifiers"

fun groupQuantifiers :: "atom fm ⇒ atom fm" where
  "groupQuantifiers TrueF = TrueF"|
  "groupQuantifiers FalseF = FalseF"|
  "groupQuantifiers (And A B) = And (groupQuantifiers A) (groupQuantifiers B)"|
  "groupQuantifiers (Or A B) = Or (groupQuantifiers A) (groupQuantifiers B)"|
  "groupQuantifiers (Neg A) = Neg (groupQuantifiers A)"|
  "groupQuantifiers (Atom A) = Atom A"|
  "groupQuantifiers (ExQ (ExQ A)) = groupQuantifiers (ExN 2 A)"|
  "groupQuantifiers (ExQ (ExN j A)) = groupQuantifiers (ExN (j+1) A)"|
  "groupQuantifiers (ExN j (ExQ A)) = groupQuantifiers (ExN (j+1) A)"|
  "groupQuantifiers (ExN i (ExN j A)) = groupQuantifiers (ExN (i+j) A)"|
  "groupQuantifiers (ExQ A) = ExQ (groupQuantifiers A)"|
  "groupQuantifiers (AllQ (AllQ A)) = groupQuantifiers (AllN 2 A)"|
  "groupQuantifiers (AllQ (AllN j A)) = groupQuantifiers (AllN (j+1) A)"|
  "groupQuantifiers (AllN j (AllQ A)) = groupQuantifiers (AllN (j+1) A)"|
  "groupQuantifiers (AllN i (AllN j A)) = groupQuantifiers (AllN (i+j) A)"|
  "groupQuantifiers (AllQ A) = AllQ (groupQuantifiers A)"|
  "groupQuantifiers (AllN j A) = AllN j A"|
  "groupQuantifiers (ExN j A) = ExN j A"

subsection "Clear Quantifiers"

text "clearQuantifiers F goes through the formula F and removes all quantifiers who's variables
are not present in the formula. For example, clearQuantifiers (ExQ(TrueF)) evaluates to TrueF. This
preserves the truth value of the formula as shown in the clearQuantifiers\\_eval proof. This is used
within the QE overall procedure to eliminate quantifiers in the cases where QE was successful."
fun depth' :: "'a fm ⇒ nat"where
  "depth' TrueF = 1"|
  "depth' FalseF = 1"|
  "depth' (Atom _) = 1"|
  "depth' (And φ ψ) = max (depth' φ) (depth' ψ) + 1"|
  "depth' (Or φ ψ) = max (depth' φ) (depth' ψ) + 1"|
  "depth' (Neg φ) = depth' φ + 1"|
  "depth' (ExQ φ) = depth' φ + 1"|
  "depth' (AllQ φ) = depth' φ + 1"|
  "depth' (AllN i φ) = depth' φ  + i * 2 + 1"|
  "depth' (ExN i φ) = depth' φ  + i * 2 + 1"

function clearQuantifiers :: "atom fm ⇒ atom fm" where
  "clearQuantifiers TrueF = TrueF"|
  "clearQuantifiers FalseF = FalseF"|
  "clearQuantifiers (Atom a) = simp_atom a"|
  "clearQuantifiers (And φ ψ) = and (clearQuantifiers φ) (clearQuantifiers ψ)"|
  "clearQuantifiers (Or φ ψ) = or (clearQuantifiers φ) (clearQuantifiers ψ)"|
  "clearQuantifiers (Neg φ) = neg (clearQuantifiers φ)"|
  "clearQuantifiers (ExQ φ) = 
  (let φ' = clearQuantifiers φ in
  (if freeIn 0 φ' then lowerFm 0 1 φ' else ExQ φ'))"|
  "clearQuantifiers (AllQ φ) = 
  (let φ' = clearQuantifiers φ in
  (if freeIn 0 φ' then lowerFm 0 1 φ' else AllQ φ'))"|
  "clearQuantifiers (ExN 0 φ) = clearQuantifiers φ"|
  "clearQuantifiers (ExN (Suc i) φ) = clearQuantifiers (ExN i (ExQ φ))"|
  "clearQuantifiers (AllN 0 φ) = clearQuantifiers φ"|
  "clearQuantifiers (AllN (Suc i) φ) = clearQuantifiers (AllN i (AllQ φ))"
  by pat_completeness auto
termination
  apply(relation "measures [λA. depth' A]")
  by auto

subsection "Push Forall"

fun push_forall :: "atom fm ⇒ atom fm" where
  "push_forall TrueF = TrueF"|
  "push_forall FalseF = FalseF"|
  "push_forall (Atom a) = simp_atom a"|
  "push_forall (And φ ψ) = and (push_forall φ) (push_forall ψ)"|
  "push_forall (Or φ ψ) = or (push_forall φ) (push_forall ψ)"|
  "push_forall (ExQ φ) = ExQ (push_forall φ)"|
  "push_forall (ExN i φ) = ExN i (push_forall φ)"|
  "push_forall (Neg φ) = neg (push_forall φ)"|
  "push_forall (AllQ TrueF) = TrueF"|
  "push_forall (AllQ FalseF) = FalseF"|
  "push_forall (AllQ (Atom a)) = (if freeIn 0 (Atom a) then Atom(lowerAtom 0 1 a) else AllQ (Atom a))"|
  "push_forall (AllQ (And φ ψ)) = and (push_forall (AllQ φ)) (push_forall (AllQ ψ))"|
  "push_forall (AllQ (Or φ ψ)) = ( 
  if freeIn 0 φ  
  then(
    if freeIn 0 ψ
    then or (lowerFm 0 1 φ) (lowerFm 0 1 ψ)
    else or (lowerFm 0 1 φ) (AllQ ψ))
  else (
    if freeIn 0 ψ
    then or (AllQ φ) (lowerFm 0 1 ψ)
    else AllQ (or φ ψ))
)"|
  "push_forall (AllQ φ) = (if freeIn 0 φ then lowerFm 0 1 φ else AllQ φ)"|
  "push_forall (AllN i φ) = AllN i (push_forall  φ)" (* TODO, several bugs in this *)


subsection "Unpower"

fun to_list :: "nat ⇒ real mpoly ⇒ (real mpoly * nat) list" where
  "to_list v p = [(isolate_variable_sparse p v x, x). x ← [0..<(MPoly_Type.degree p v)+1]]"

fun chop :: "(real mpoly * nat) list ⇒ (real mpoly * nat) list"where
  "chop [] = []"|
  "chop ((p,i)#L) = (if p=0 then chop L else (p,i)#L)"

fun decreasePower :: "nat ⇒ real mpoly ⇒ real mpoly * nat"where
  "decreasePower v p = (case chop (to_list v p) of [] ⇒ (p,0) | ((p,i)#L) ⇒ (sum_list [term * (Var v) ^ (x-i). (term,x)←((p,i)#L)],i))"

fun unpower :: "nat ⇒ atom fm ⇒ atom fm" where
  "unpower v (Atom (Eq p)) = (case decreasePower v p of (_,0) ⇒ Atom(Eq p)| (p,_) ⇒ Or(Atom (Eq p))(Atom (Eq (Var v))) )"|
  "unpower v (Atom (Neq p)) = (case decreasePower v p of (_,0) ⇒ Atom(Neq p)| (p,_) ⇒ And(Atom (Neq p))(Atom (Neq (Var v))) )"|
  "unpower v (Atom (Less p)) = (case decreasePower v p of (_,0) ⇒ Atom(Less p)| (p,n) ⇒
  if n mod 2 = 0 then 
    And(Atom (Less p))(Atom(Neq (Var v)))
  else
    Or
      (And (Atom (Less ( p))) (Atom (Less (-Var v))))
      (And (Atom (Less (-p))) (Atom (Less (Var v))))
 )"|
  "unpower v (Atom (Leq p)) = (case decreasePower v p of (_,0) ⇒ Atom(Leq p)| (p,n) ⇒
  if n mod 2 = 0 then 
    Or (Atom (Leq p)) (Atom (Eq (Var v)))
  else
    Or (Atom (Eq p))
    (Or
      (And (Atom (Less ( p))) (Atom (Leq (-Var v))))
      (And (Atom (Less (-p))) (Atom (Leq (Var v)))))
 )"|
  "unpower v (And a b) = And (unpower v a) (unpower v b)"|
  "unpower v (Or a b) = Or (unpower v a) (unpower v b)"|
  "unpower v (Neg a) = Neg (unpower v a)"|
  "unpower v (TrueF) = TrueF"|
  "unpower v (FalseF) = FalseF"|
  "unpower v (AllQ F) = AllQ(unpower (v+1) F)"|
  "unpower v (ExQ F) = ExQ (unpower (v+1) F)"|
  "unpower v (AllN x F) = AllN x (unpower (v+x) F)"|
  "unpower v (ExN x F) = ExN x (unpower (v+x) F)"



end

Theory OptimizationProofs

subsection "Optimization Proofs"
theory OptimizationProofs
  imports Optimizations
begin

lemma neg_nnf : "∀Γ. (¬ eval (nnf (Neg φ)) Γ) = eval (nnf φ) Γ"
  apply(induction φ)
           apply(simp_all)
  using aNeg_aEval apply blast
  using aNeg_aEval by blast

theorem eval_nnf : "∀Γ. eval φ Γ = eval (nnf φ) Γ"
  apply(induction φ)apply(simp_all) using neg_nnf by blast


theorem negation_free_nnf : "negation_free (nnf φ)"
proof(induction "depth φ" arbitrary : φ rule: nat_less_induct )
  case 1
  then show ?case
  proof(induction φ)
    case (And φ1 φ2)
    then show ?case apply simp
      by (metis less_Suc_eq_le max.cobounded1 max.cobounded2)
  next
    case (Or φ1 φ2)
    then show ?case apply simp
      by (metis less_Suc_eq_le max.cobounded1 max.cobounded2)
  next
    case (Neg φ)
    then show ?case proof (induction φ)
      case (And φ1 φ2)
      then show ?case apply simp
        by (metis less_Suc_eq max_less_iff_conj not_less_eq)
    next
      case (Or φ1 φ2)
      then show ?case apply simp
        by (metis less_Suc_eq max_less_iff_conj not_less_eq)
    next
      case (Neg φ)
      then show ?case
        by (metis Suc_eq_plus1 add_lessD1 depth.simps(6) lessI nnf.simps(12))
    qed auto
  qed auto
qed


lemma groupQuantifiers_eval : "eval F L = eval (groupQuantifiers F) L"
  apply(induction F arbitrary: L  rule:groupQuantifiers.induct) 
  unfolding doubleExist unwrapExist unwrapExist' unwrapExist'' doubleForall unwrapForall unwrapForall' unwrapForall''
  apply (auto)
  using doubleExist doubleExist unwrapExist unwrapExist' unwrapExist'' doubleForall unwrapForall unwrapForall' unwrapForall''  apply auto
  by metis+


theorem simp_atom_eval : "aEval a xs = eval (simp_atom a) xs"
proof(cases a)
  case (Less p)
  then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
next
  case (Eq p)
  then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
next
  case (Leq p)
  then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
next
  case (Neq p)
  then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion)
qed

lemma simpfm_eval : "∀L. eval φ L = eval (simpfm φ) L"
  apply(induction φ)
  apply(simp_all add: simp_atom_eval eval_and eval_or)
  using eval_neg by blast

lemma exQ_clearQuantifiers:
  assumes ExQ : "⋀xs. eval (clearQuantifiers φ) xs = eval φ xs"
  shows "eval (clearQuantifiers (ExQ φ)) xs = eval (ExQ φ) xs"
proof-
  define φ' where "φ' = clearQuantifiers φ"
  have h : "freeIn 0 φ' ⟹ (eval (lowerFm 0 1 φ') xs = eval (ExQ φ') xs)"
    using eval_lowerFm by simp
  have "eval (clearQuantifiers (ExQ φ)) xs = 
      eval (if freeIn 0 φ' then lowerFm 0 1 φ' else ExQ φ') xs"
    using φ'_def by simp
  also have "... = eval (ExQ φ) xs"
    apply(cases "freeIn 0 φ'")
    using h ExQ φ'_def by(simp_all)
  finally show ?thesis
    by simp
qed

lemma allQ_clearQuantifiers :
  assumes AllQ : "⋀xs. eval (clearQuantifiers φ) xs = eval φ xs"
  shows "eval (clearQuantifiers (AllQ φ)) xs = eval (AllQ φ) xs"
proof-
  define φ' where "φ' = clearQuantifiers φ"
  have "freeIn 0 φ' ⟹ (eval (ExQ φ') xs) = eval (AllQ φ') xs"
    by (simp add: var_not_in_eval2)
  then have h : "freeIn 0 φ' ⟹ (eval (lowerFm 0 1 φ') xs = eval (AllQ φ') xs)"
    using eval_lowerFm by simp
  have "eval (clearQuantifiers (AllQ φ)) xs = 
      eval (if freeIn 0 φ' then lowerFm 0 1 φ' else AllQ φ') xs"
    using φ'_def by simp
  also have "... = eval (AllQ φ) xs"
    apply(cases "freeIn 0 φ'")
    using h AllQ φ'_def by(simp_all)
  finally show ?thesis 
    by simp
qed

lemma clearQuantifiers_eval : "eval (clearQuantifiers φ) xs = eval φ xs"
proof(induction φ arbitrary : xs)
  case (Atom x)
  then show ?case using simp_atom_eval by simp
next
  case (And φ1 φ2)
  then show ?case using eval_and by simp
next
  case (Or φ1 φ2)
  then show ?case using eval_or by simp
next
  case (Neg φ)
  then show ?case using eval_neg by auto
next
  case (ExQ φ)
  then show ?case using exQ_clearQuantifiers by simp
next
  case (AllQ φ)
  then show ?case using allQ_clearQuantifiers by simp
next
  case (ExN x1 φ)
  then show ?case proof(induction x1 arbitrary:φ)
    case 0
    then show ?case by auto
  next
    case (Suc x1)
    show ?case
      using Suc(1)[of "ExQ φ", OF exQ_clearQuantifiers[OF Suc(2)]]
      apply simp
      using Suc_eq_plus1 ‹eval (clearQuantifiers (ExN x1 (ExQ φ))) xs = eval (ExN x1 (ExQ φ)) xs› eval.simps(10) unwrapExist' by presburger
  qed
next
  case (AllN x1 φ)
  then show ?case proof(induction x1 arbitrary:φ)
    case 0
    then show ?case by auto
  next
    case (Suc x1)
    show ?case
      using Suc(1)[of "AllQ φ", OF allQ_clearQuantifiers[OF Suc(2)]]
      apply simp
      using unwrapForall' by force
  qed
qed auto

lemma  push_forall_eval_AllQ : "∀xs. eval (AllQ φ) xs = eval (push_forall (AllQ φ)) xs"
proof(induction φ)
  case TrueF
  then show ?case by simp
next
  case FalseF
  then show ?case by simp
next
  case (Atom x)
  then show ?case
    using aEval_lowerAtom eval.simps(1) eval.simps(8) push_forall.simps(11) by presburger
next
  case (And φ1 φ2)
  {fix xs
    have "eval (AllQ (And φ1 φ2)) xs = (∀x. eval φ1 (x#xs) ∧ eval φ2 (x#xs))"
      by simp
    also have "... = ((∀x. eval φ1 (x#xs)) ∧ (∀x. eval φ2 (x#xs)))"
      by blast
    also have "... = eval (push_forall (AllQ (And φ1 φ2))) xs"
      using And eval_and by(simp)
    finally have "eval (AllQ (And φ1 φ2)) xs = eval (push_forall (AllQ (And φ1 φ2))) xs"
      by simp
  }
  then show ?case by simp 
next
  case (Or φ1 φ2)
  then show ?case proof(cases "freeIn 0 φ1")
    case True
    then have h : "freeIn 0 φ1"
      by simp
    then show ?thesis proof(cases "freeIn 0 φ2")
      case True
      {fix xs
        have "∃x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs"
          using eval_lowerFm h eval.simps(7) by blast 
        then have h1 : "∀x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs"
          using h var_not_in_eval2 by blast
        have "∃x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs"
          using eval_lowerFm True eval.simps(7) by blast 
        then have h2 : "∀x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs"
          using True var_not_in_eval2 by blast
        have "eval (AllQ (Or φ1 φ2)) xs = eval (push_forall (AllQ (Or φ1 φ2))) xs"
          by(simp add:h h1 h2 True eval_or)
      }
      then show ?thesis by simp
    next
      case False
      {fix xs
        have "∃x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs"
          using eval_lowerFm h eval.simps(7) by blast 
        then have "∀x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs"
          using True var_not_in_eval2 by blast
        then have "eval (AllQ (Or φ1 φ2)) xs = eval (push_forall (AllQ (Or φ1 φ2))) xs"
          by(simp add:h False eval_or)
      }
      then show ?thesis by simp
    qed
  next
    case False
    then have h : "¬freeIn 0 φ1"
      by simp
    then show ?thesis proof(cases "freeIn 0 φ2")
      case True
      {fix xs
        have "∃x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs"
          using eval_lowerFm True eval.simps(7) by blast 
        then have "∀x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs"
          using True var_not_in_eval2 by blast
        then have "eval (AllQ (Or φ1 φ2)) xs = eval (push_forall (AllQ (Or φ1 φ2))) xs"
          by(simp add:h True eval_or)
      }
      then show ?thesis by simp
    next
      case False
      then show ?thesis by(simp add:h False eval_or)
    qed
  qed
next
  case (Neg φ)
  {fix xs
    have "freeIn 0 (Neg φ) ⟹ (eval (ExQ (Neg φ)) xs) = eval (AllQ (Neg φ)) xs"
      using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast
    then have h : "freeIn 0 (Neg φ) ⟹ (eval (lowerFm 0 1 (Neg φ)) xs = eval (AllQ (Neg φ)) xs)"
      using eval_lowerFm by blast
    have "eval (push_forall (AllQ (Neg φ))) xs = 
      eval (if freeIn 0 (Neg φ) then lowerFm 0 1 (Neg φ) else AllQ (Neg φ)) xs"
      by simp
    also have "... = eval (AllQ (Neg φ)) xs"
      apply(cases "freeIn 0 (Neg φ)")
      using h  by(simp_all)
    finally have "eval (push_forall (AllQ (Neg φ))) xs = eval (AllQ (Neg φ)) xs"
      by simp
  }
  then show ?case by simp
next
  case (ExQ φ)
  {fix xs
    have "freeIn 0 (ExQ φ) ⟹ (eval (ExQ (ExQ φ)) xs) = eval (AllQ (ExQ φ)) xs"
      using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast
    then have h : "freeIn 0 (ExQ φ) ⟹ (eval (lowerFm 0 1 (ExQ φ)) xs = eval (AllQ (ExQ φ)) xs)"
      using eval_lowerFm by blast
    have "eval (push_forall (AllQ (ExQ φ))) xs = 
      eval (if freeIn 0 (ExQ φ) then lowerFm 0 1 (ExQ φ) else AllQ (ExQ φ)) xs"
      by simp
    also have "... = eval (AllQ (ExQ φ)) xs"
      apply(cases "freeIn 0 (ExQ φ)")
      using h  by(simp_all)
    finally have "eval (push_forall (AllQ (ExQ φ))) xs = eval (AllQ (ExQ φ)) xs"
      by simp
  }
  then show ?case by simp
next
  case (AllQ φ)
  {fix xs
    have "freeIn 0 (AllQ φ) ⟹ (eval (ExQ (AllQ φ)) xs) = eval (AllQ (AllQ φ)) xs"
      using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast
    then have h : "freeIn 0 (AllQ φ) ⟹ (eval (lowerFm 0 1 (AllQ φ)) xs = eval (AllQ (AllQ φ)) xs)"
      using eval_lowerFm by blast
    have "eval (push_forall (AllQ (AllQ φ))) xs = 
      eval (if freeIn 0 (AllQ φ) then lowerFm 0 1 (AllQ φ) else AllQ (AllQ φ)) xs"
      by simp
    also have "... = eval (AllQ (AllQ φ)) xs"
      apply(cases "freeIn 0 (AllQ φ)")
      using h AllQ  by(simp_all)
    finally have "eval (push_forall (AllQ (AllQ φ))) xs = eval (AllQ (AllQ φ)) xs"
      by simp
  }
  then show ?case by simp
next
  case (ExN x1 φ)
  then show ?case
    using eval.simps(7) eval.simps(8) eval_lowerFm push_forall.simps(17) var_not_in_eval2 by presburger
next
  case (AllN x1 φ)
  then show ?case
    using eval.simps(7) eval.simps(8) eval_lowerFm push_forall.simps(18) var_not_in_eval2 by presburger
qed

lemma push_forall_eval : "∀xs. eval φ xs = eval (push_forall φ) xs"
proof(induction φ)
  case (Atom x)
  then show ?case using simp_atom_eval by simp
next
  case (And φ1 φ2)
  then show ?case using eval_and by auto
next
  case (Or φ1 φ2)
  then show ?case using eval_or by auto
next
  case (Neg φ)
  then show ?case using eval_neg by auto
next
  case (AllQ φ)
  then show ?case using push_forall_eval_AllQ by blast 
next
  case (ExN x1 φ)
  then show ?case
    using eval.simps(10) push_forall.simps(7) by presburger
qed auto

lemma map_fm_binders_negation_free : 
  assumes "negation_free φ"
  shows "negation_free (map_fm_binders f φ n)"
  using assms apply(induction φ arbitrary : n) by auto

lemma negation_free_and : 
  assumes "negation_free φ"
  assumes "negation_free ψ"
  shows "negation_free (and φ ψ)"
  using assms unfolding and_def by simp 

lemma negation_free_or : 
  assumes "negation_free φ"
  assumes "negation_free ψ"
  shows "negation_free (or φ ψ)"
  using assms unfolding or_def by simp 

lemma push_forall_negation_free_all :
  assumes "negation_free φ"
  shows "negation_free (push_forall (AllQ φ))"
  using assms proof(induction φ)
  case (And φ1 φ2)
  show ?case apply auto
    apply(rule negation_free_and)
    using And by auto
next
  case (Or φ1 φ2)
  show ?case
    apply auto
    apply(rule negation_free_or)   
    using Or map_fm_binders_negation_free negation_free_or by auto
next
  case (ExQ φ)
  then show ?case using map_fm_binders_negation_free by auto
next
  case (AllQ φ)
  then show ?case using map_fm_binders_negation_free by auto
next
  case (ExN x1 φ)
  then show ?case using map_fm_binders_negation_free by auto
next
  case (AllN x1 φ)
  then show ?case using map_fm_binders_negation_free by auto
qed auto

lemma push_forall_negation_free : 
  assumes "negation_free φ"  
  shows "negation_free(push_forall φ)"
  using assms proof(induction φ)
  case (Atom A)
  then show ?case apply(cases A) by auto
next
  case (And φ1 φ2)
  then show ?case by (auto simp add: and_def)
next
  case (Or φ1 φ2)
  then show ?case by (auto simp add: or_def)
next
  case (AllQ φ)
  then show ?case using push_forall_negation_free_all by auto
qed auto


lemma to_list_insertion: "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←(to_list v p)]"
proof-
  have h1 :  "insertion f p = insertion f (∑i≤MPoly_Type.degree p v. isolate_variable_sparse p v i * Var v ^ i)"
    using sum_over_zero by auto
  have h2 : "insertion f (Var v) = f v" by (auto simp: monomials_Var coeff_Var insertion_code)
  define d where "d = MPoly_Type.degree p v"
  define g where "g = (λx. insertion f (isolate_variable_sparse p v x) * f v ^ x)"
  have h3 : "insertion f (isolate_variable_sparse p v d) * f v ^ d = g d" using g_def by auto
  show ?thesis unfolding h1
      insertion_sum' insertion_mult insertion_pow h2 apply auto unfolding d_def[symmetric] g_def[symmetric]
      h3  proof(induction d)
    case 0
    then show ?case by auto
  next
    case (Suc d)
    show ?case
      apply (auto simp add: Suc ) unfolding g_def by auto
  qed
qed

lemma to_list_p: "p = sum_list [term * (Var v) ^ i. (term,i)←(to_list v p)]"
proof-
  define d where "d = MPoly_Type.degree p v"
  have "(∑i≤MPoly_Type.degree p v. isolate_variable_sparse p v i * Var v ^ i) = (∑(term, i)←to_list v p. term * Var v ^ i)"
    unfolding to_list.simps d_def[symmetric] apply(induction d) by auto
  then show ?thesis 
    using sum_over_zero[of p v]
    by auto
qed


fun chophelper :: "(real mpoly * nat) list ⇒ (real mpoly * nat) list ⇒ (real mpoly * nat) list * (real mpoly * nat) list" where
  "chophelper [] L = (L,[])"|
  "chophelper ((p,i)#L) R = (if p=0 then chophelper L (R @ [(p,i)]) else (R,(p,i)#L))"

lemma preserve :
  assumes "(a,b)=chophelper L L'"
  shows "a@b=L'@L"
  using assms
proof(induction L arbitrary : a b L')
  case Nil
  then show ?case using assms by auto
next
  case (Cons A L)
  then show ?case proof(cases A)
    case (Pair p i)
    show ?thesis using Cons unfolding Pair apply(cases "p=0") by auto
  qed
qed
lemma compare : 
  assumes "(a,b)=chophelper L L'"
  shows "chop L = b"
  using assms
proof(induction L arbitrary : a b L')
  case Nil
  then show ?case by auto
next
  case (Cons A L)
  then show ?case proof(cases A)
    case (Pair p i)
    show ?thesis using Cons unfolding Pair apply(cases "p=0") by auto
  qed
qed
lemma allzero:
  assumes "∀(p,i)∈set(L'). p=0"
  assumes "(a,b)=chophelper L L'"
  shows "∀(p,i)∈set(a). p=0"
  using assms proof(induction L arbitrary : a b L')
  case Nil
  then show ?case by auto
next
  case (Cons t L)
  then show ?case
  proof(cases t)
    case (Pair p i)
    show ?thesis proof(cases "p=0")
      case True
      have h1: "∀x∈set (L' @ [(0, i)]). case x of (p, i) ⇒ p = 0"
        using Cons(2) by auto
      show ?thesis using Cons(1)[OF h1] Cons(3) True unfolding Pair by auto
    next
      case False
      then show ?thesis using Cons unfolding Pair by auto
    qed
  qed
qed 

lemma separate:
  assumes "(a,b)=chophelper (to_list v p) []"
  shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←a] + sum_list [insertion f term * (f v) ^ i. (term,i)←b]"
  using to_list_insertion[of f p v]  preserve[OF assms, symmetric] unfolding List.append.left_neutral
  by (simp del: to_list.simps)

lemma chopped : 
  assumes "(a,b)=chophelper (to_list v p) []"
  shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←b]"
proof-
  have h1 : "∀(p, i)∈set []. p = 0" by auto
  have "(∑(term, i)←a. insertion f term * f v ^ i) = 0"
    using allzero[OF h1 assms] proof(induction a)
    case Nil
    then show ?case by auto
  next
    case (Cons a1 a2)
    then show ?case
      apply(cases a1) by simp
  qed 
  then show ?thesis using separate[OF assms, of f] by auto
qed

lemma insertion_chop : 
  shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←(chop (to_list v p))]" 
proof(cases "chophelper (to_list v p) []")
  case (Pair a b)
  show ?thesis using chopped[OF Pair[symmetric], of f] unfolding compare[OF Pair[symmetric], symmetric] .
qed

lemma sorted : "sorted_wrt (λ(_,i).λ(_,i'). i<i') (to_list v p)"
proof -
  define d  where "d = MPoly_Type.degree p v"
  show ?thesis unfolding to_list.simps d_def[symmetric] 
  proof(induction d)
    case 0
    then show ?case by auto
  next
    case (Suc d)
    have h : "(map (λx. (isolate_variable_sparse p v x, x)) [0..<Suc d + 1]) = 
        (map (λx. (isolate_variable_sparse p v x, x)) [0..<Suc d]) @ [(isolate_variable_sparse p v (Suc d), (Suc d))]"
      by auto
    show ?case
      unfolding sorted_wrt_append h
      using Suc
      by auto
  qed
qed

lemma sublist : "sublist (chop L) L"
proof(induction L)
  case Nil
  then show ?case by auto
next
  case (Cons a L)
  then show ?case proof(cases a)
    case (Pair a b)
    show ?thesis using Cons unfolding Pair apply auto
      by (simp add: sublist_Cons_right)
  qed
qed



lemma move_exp :
  assumes "(p',i)#L = (chop (to_list v p))"
  shows "insertion f p = sum_list [insertion f term * (f v) ^ (d-i). (term,d)←(chop (to_list v p))] * (f v)^i" 
proof-
  have h : "sorted_wrt (λ(_, i) (_, y). i < y) (chop (to_list v p))"
  proof-
    define L where "L = to_list v p"
    show ?thesis using sublist[of "to_list v p"] sorted[of v p] unfolding L_def[symmetric]
      by (metis sorted_wrt_append sublist_def)
  qed
  then have "∀(term,d)∈set(chop (to_list v p)). d≥i"
    unfolding assms[symmetric]  by fastforce
  then have simp : "∀(term,d)∈set(chop(to_list v p)). f v ^ (d - i) * f v ^ i = f v ^ d"
    unfolding HOL.no_atp(118) by(auto simp del: to_list.simps)
  have "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←(chop (to_list v p))]" using insertion_chop[of f p v] .
  also have "...= (∑(term, d)←chop (to_list v p). insertion f term * f v ^ (d-i) * f v ^ i)" 
    using simp
    by (smt Pair_inject case_prodE map_eq_conv mult.assoc split_cong) 
  also have "... =  (∑(term, d)←chop (to_list v p). insertion f term * f v ^ (d - i)) * f v ^ i"
  proof-
    define d where "d = chop(to_list v p)"
    define a where "a = f v ^ i"
    define b where "b = (λ(term, d). insertion f term * f v ^ (d - i))"
    have h : "(∑(term, d)←d. insertion f term * f v ^ (d - i) * a) = (∑(term, d)←d. b (term,d) * a)"
      using b_def by auto
    show ?thesis unfolding d_def[symmetric] a_def[symmetric]  b_def[symmetric] h  apply(induction d) apply simp apply auto
      by (simp add: ring_class.ring_distribs(2))
  qed
  finally show ?thesis by auto
qed

lemma insert_Var_Zero : "insertion f (Var v) = f v"
  unfolding insertion_code monomials_Var apply auto
  unfolding coeff_Var by simp


lemma decreasePower_insertion :
  assumes "decreasePower v p = (p',i)"
  shows "insertion f p = insertion f p'* (f v)^i"
proof(cases "chop (to_list v p)")
  case Nil
  then show ?thesis
    using assms by auto
next
  case (Cons a list)
  then show ?thesis
  proof(cases a)
    case (Pair coef i')
    have i'_def : "i'=i" using Cons assms Pair by auto
    have chop: "chop (to_list v p) = (coef, i) # list" using Cons assms unfolding i'_def Pair by auto
    have p'_def :  "p' = (∑(term, x)←chop (to_list v p). term * Var v ^ (x - i))"
      using assms Cons Pair by auto 
    have p'_insertion : "insertion f p' = (∑(term, x)←chop (to_list v p). insertion f term * f v ^ (x - i))"
    proof-
      define d where "d = chop (to_list v p)"
      have "insertion f p' = insertion f (∑(term, x)←chop (to_list v p). term * Var v ^ (x - i))" using p'_def by auto
      also have "... = (∑(term, x)←chop (to_list v p).  insertion f (term * Var v ^ (x - i)))" 
        unfolding d_def[symmetric] apply(induction d) apply simp apply(simp add:insertion_add) by auto
      also have "... = (∑(term, x)←chop (to_list v p). insertion f term * f v ^ (x - i))" unfolding insertion_mult insertion_pow insert_Var_Zero by auto
      finally show ?thesis by auto
    qed
    have h : "(coef, i') # list = chop (to_list v p)"  using Cons unfolding Pair by auto
    show ?thesis unfolding p'_insertion
      using move_exp[OF h, of f] unfolding i'_def .
  qed
qed 


lemma unpower_eval: "eval (unpower v φ) L = eval φ L"
proof(induction φ arbitrary: v L)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom At)
  then show ?case proof(cases At)
    case (Less p)
    obtain q i where h: "decreasePower v p = (q, i)"
      using prod.exhaust_sel by blast
    have p : "⋀f. insertion f p = insertion f q* (f v)^i"
      using decreasePower_insertion[OF h] by auto
    show ?thesis
    proof(cases "i=0")
      case True
      then show ?thesis unfolding Less unpower.simps h  by auto
    next
      case False
      obtain x where x_def : "Suc x = i" using False
        using not0_implies_Suc by auto 
      have h1 : "i mod 2 = 0 ⟹
    (insertion (nth_default 0 L) q < 0 ∧
     insertion (nth_default 0 L) (Var v) ≠ 0) =
    (insertion (nth_default 0 L) q * nth_default 0 L v ^ i < 0)"
      proof -
        assume "i mod 2 = 0"
        then have "∀r. ¬ (r::real) ^ i < 0"
          by presburger
        then show ?thesis
          by (metis ‹⋀thesis. (⋀x. Suc x = i ⟹ thesis) ⟹ thesis› insert_Var_Zero linorder_neqE_linordered_idom mult_less_0_iff power_0_Suc power_eq_0_iff)
      qed
      show ?thesis unfolding Less unpower.simps h x_def[symmetric] apply simp
        unfolding x_def p apply(cases "i mod 2 = 0") using h1 apply simp_all
        by (smt insert_Var_Zero insertion_neg mod_Suc mod_eq_0D mult_less_0_iff nat.inject odd_power_less_zero power_0 power_Suc0_right power_eq_0_iff x_def zero_less_Suc zero_less_power)
    qed 
  next
    case (Eq p)
    obtain q i where h: "decreasePower v p = (q, i)"
      using prod.exhaust_sel by blast
    have p : "⋀f. insertion f p = insertion f q* (f v)^i"
      using decreasePower_insertion[OF h] by auto
    show ?thesis unfolding Eq unpower.simps h apply simp apply(cases i) apply simp
      apply simp unfolding p apply simp
      by (metis insert_Var_Zero)
  next
    case (Leq p)
    obtain q i where h: "decreasePower v p = (q, i)"
      using prod.exhaust_sel by blast
    have p : "⋀f. insertion f p = insertion f q* (f v)^i"
      using decreasePower_insertion[OF h] by auto
    show ?thesis
    proof(cases "i=0")
      case True
      then show ?thesis unfolding Leq unpower.simps h  by auto
    next
      case False
      obtain x where x_def : "Suc x = i" using False
        using not0_implies_Suc by auto 
      define a where "a = insertion (nth_default 0 L) q"
      define x' where "x' = nth_default 0 L v"
      show ?thesis unfolding Leq unpower.simps h x_def[symmetric] apply simp
        unfolding x_def p apply(cases "i mod 2 = 0") unfolding insert_Var_Zero insertion_mult insertion_pow insertion_neg apply simp_all
        unfolding a_def[symmetric] x'_def[symmetric]
      proof-
        assume "i mod 2 = 0"
        then have "x' ^ i ≥0"
          by (simp add: ‹i mod 2 = 0› even_iff_mod_2_eq_zero zero_le_even_power) 
        then show "(a ≤ 0 ∨ x' = 0) = (a * x' ^ i ≤ 0)"
          using Rings.ordered_semiring_0_class.mult_nonpos_nonneg[of a "x'^i"]
          apply auto
          unfolding Rings.linordered_ring_strict_class.mult_le_0_iff
          apply auto
          by (simp add: False power_0_left)
      next
        assume h:  "i mod 2 = Suc 0"
        show "(a = 0 ∨ a < 0 ∧ 0 ≤ x' ∨ 0 < a ∧ x' ≤ 0) = (a * x' ^ i ≤ 0)"
          using h
          by (smt even_iff_mod_2_eq_zero mult_less_cancel_right mult_neg_neg mult_nonneg_nonpos mult_pos_pos not_mod2_eq_Suc_0_eq_0 power_0_Suc x_def zero_le_power_eq zero_less_mult_pos2 zero_less_power)
      qed
    qed 
  next
    case (Neq p)
    obtain q i where h: "decreasePower v p = (q, i)"
      using prod.exhaust_sel by blast
    have p : "⋀f. insertion f p = insertion f q* (f v)^i"
      using decreasePower_insertion[OF h] by auto
    show ?thesis unfolding Neq unpower.simps h apply simp apply(cases i) apply simp
      apply simp unfolding p apply simp
      by (metis insert_Var_Zero)
  qed
qed auto

lemma to_list_filter: "p = sum_list [term * (Var v) ^ i. (term,i)←((filter (λ(x,_). x≠0) (to_list v p)))]"
proof-
  define L where "L = to_list v p"
  have "(∑(term, i)←to_list v p. term * Var v ^ i) = (∑(term, i)←filter (λ(x, _). x ≠ 0) (to_list v p). term * Var v ^ i)"
    unfolding L_def[symmetric] apply(induction L) by auto
  then show ?thesis
    using to_list_p[of p v] by auto
qed

end

Theory VSAlgos

section "Algorithms"
subsection "Equality VS Helper Functions"
theory VSAlgos
  imports Debruijn Optimizations
begin


text "This is a subprocess which simply separates out the equality atoms from the other kinds of atoms

Note that we search for equality atoms that are of degree one or two

This is used within the equalityVS algorithm"
fun find_eq :: "nat ⇒ atom list ⇒ real mpoly list * atom list" where
  "find_eq var [] = ([],[])"|
  "find_eq var ((Less p)#as) = (let (A,B) = find_eq var as in (A,Less p#B))" |
  "find_eq var ((Eq p)#as) = (let (A,B) = find_eq var as in
   if MPoly_Type.degree p var < 3 ∧ MPoly_Type.degree p var ≠ 0
  then (p # A,B) 
  else (A,Eq p # B)
)"|
  "find_eq var ((Leq p)#as) = (let (A,B) = find_eq var as in (A,Leq p#B))" |
  "find_eq var ((Neq p)#as) = (let (A,B) = find_eq var as in (A,Neq p#B))"




(* given ax^2+bx+c returns formula representing a=0 and b=0 and c=0 *)
fun split_p :: "nat ⇒ real mpoly ⇒ atom fm" where
  "split_p var p = And (Atom (Eq (isolate_variable_sparse p var 2)))
                (And (Atom (Eq (isolate_variable_sparse p var 1)))
                     (Atom (Eq (isolate_variable_sparse p var 0))))"



text "
The linearsubstitution virtually substitutes in an equation of $b*x+c=0$ into an arbitrary atom

linearsubstitution x b c (Eq p) = F corresponds to removing variable x from polynomial p and replacing
it with an equivalent function F where F doesn't mention variable x

If there exists a way to assign variables that makes p = 0 true,
then that same set of variables will make F true

If there exists a way to assign variables that makes F true and also have b*x+c=0,
then that same set of variables will make p=0 true

Same applies for other kinds of atoms that aren't equality
"
fun linear_substitution :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom" where
  "linear_substitution var a b (Eq p) = 
  (let d = MPoly_Type.degree p var in
    (Eq (∑i∈{0..<(d+1)}.  isolate_variable_sparse p var i * (a^i) * (b^(d-i))))
  )" |
  "linear_substitution var a b (Less p) = 
  (let d = MPoly_Type.degree p var in
    let P = (∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (a^i) * (b^(d-i))) in
      (Less(P * (b ^ (d mod 2))))
    )"|
  "linear_substitution var a b (Leq p) = 
  (let d = MPoly_Type.degree p var in
    let P = (∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (a^i) * (b^(d-i))) in
      (Leq(P * (b ^ (d mod 2))))
    )"|
  "linear_substitution var a b (Neq p) = 
  (let d = MPoly_Type.degree p var in
    (Neq (∑i∈{0..<(d+1)}.  isolate_variable_sparse p var i * (a^i) * (b^(d-i))))
  )"

fun linear_substitution_fm_helper :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ nat ⇒ atom fm" where
  "linear_substitution_fm_helper var b c F z = liftmap (λx.λA. Atom(linear_substitution (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A)) F z"

fun linear_substitution_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where
  "linear_substitution_fm var b c F = linear_substitution_fm_helper var b c F 0"


text "
quadraticpart1 var a b A takes in an expression of the form
(a+b * sqrt(c))/d
for an arbitrary c and substitutes it in for the variable var in the atom A
"
fun quadratic_part_1 :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ real mpoly" where
  "quadratic_part_1 var a b d (Eq p) = (
  let deg = MPoly_Type.degree p var in
  ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i))
)" |
  "quadratic_part_1 var a b d (Less p) = (
  let deg = MPoly_Type.degree p var in
  let P = ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i)) in
  P * (d ^ (deg mod 2))
)"|
  "quadratic_part_1 var a b d (Leq p) = (
  let deg = MPoly_Type.degree p var in
  let P = ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i)) in
  P * (d ^ (deg mod 2))
)"|
  "quadratic_part_1 var a b d (Neq p) = (
  let deg = MPoly_Type.degree p var in
  ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i))
)"

fun quadratic_part_2 :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly" where
  "quadratic_part_2 var sq p = (
  let deg = MPoly_Type.degree p var in
  ∑i∈{0..<deg+1}. 
    (isolate_variable_sparse p var i)*(sq^(i div 2)) * (Const(of_nat(i mod 2))) * (Var var) 
   +(isolate_variable_sparse p var i)*(sq^(i div 2)) * Const(1-of_nat(i mod 2))
)
"

text"
quadraticsub var a b c d A represents virtually substituting an expression of the form
(a+b*sqrt(c))/d into variable var in atom A
"
primrec quadratic_sub :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom fm" where
  "quadratic_sub var a b c d (Eq p) = (
    let (p1::real mpoly) = quadratic_part_1 var a b d (Eq p) in
    let (p2::real mpoly) = quadratic_part_2 var c p1 in
    let (A::real mpoly) = isolate_variable_sparse p2 var 0 in
    let (B::real mpoly) = isolate_variable_sparse p2 var 1 in
    And
      (Atom(Leq (A*B)))
      (Atom (Eq (A^2-B^2*c)))
)" | 
  "quadratic_sub var a b c d (Less p) = (
    let (p1::real mpoly) = quadratic_part_1 var a b d (Less p) in
    let (p2::real mpoly) = quadratic_part_2 var c p1 in
    let (A::real mpoly) = isolate_variable_sparse p2 var 0 in
    let (B::real mpoly) = isolate_variable_sparse p2 var 1 in
    Or
      (And
        (Atom(Less(A)))
        (Atom (Less (B^2*c-A^2))))
      (And
        (Atom(Leq B))
        (Or
          (Atom(Less A))
          (Atom(Less (A^2-B^2*c)))))
)" |
  "quadratic_sub var a b c d (Leq p) = (
    let (p1::real mpoly) = quadratic_part_1 var a b d (Leq p) in
    let (p2::real mpoly) = quadratic_part_2 var c p1 in
    let (A::real mpoly) = isolate_variable_sparse p2 var 0 in
    let (B::real mpoly) = isolate_variable_sparse p2 var 1 in
    Or
      (And
        (Atom(Leq(A)))
        (Atom (Leq(B^2*c-A^2))))
      (And
        (Atom(Leq B))
        (Atom(Leq (A^2-B^2*c))))
)" |
  "quadratic_sub var a b c d (Neq p) = (
    let (p1::real mpoly) = quadratic_part_1 var a b d (Neq p) in
    let (p2::real mpoly) = quadratic_part_2 var c p1 in
    let (A::real mpoly) = isolate_variable_sparse p2 var 0 in
    let (B::real mpoly) = isolate_variable_sparse p2 var 1 in
    Or
      (Atom(Less(-A*B)))
      (Atom (Neq(A^2-B^2*c)))
)"


fun quadratic_sub_fm_helper :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ nat ⇒ atom fm" where
  "quadratic_sub_fm_helper var a b c d F z = liftmap (λx.λA. quadratic_sub (var+x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A) F z"

fun quadratic_sub_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where
  "quadratic_sub_fm var a b c d F = quadratic_sub_fm_helper var a b c d F 0"

subsection "General VS Helper Functions"
  (*
  allZero p var
  takes in a polynomial of the form sum a_i x^i where x is the variable var
  returns the formula where all a_i=0
*)
fun allZero :: "real mpoly ⇒ nat ⇒ atom fm" where
  "allZero p var = list_conj [Atom(Eq(isolate_variable_sparse p var i)). i <- [0..<(MPoly_Type.degree p var)+1]]"

fun alternateNegInfinity :: "real mpoly ⇒ nat ⇒ atom fm" where
  "alternateNegInfinity p var = foldl (λF.λi.
let a_n = isolate_variable_sparse p var i in
let exp = (if i mod 2 = 0 then Const(1) else Const(-1)) in
  or (Atom(Less (exp * a_n)))
    (and (Atom (Eq a_n)) F)
) FalseF ([0..<((MPoly_Type.degree p var)+1)])"


(*
  substNegInfity var a
  substitutes negative infinity for the variable var in the atom a
  defined in pages 610-611
*)
fun substNegInfinity :: "nat ⇒ atom ⇒ atom fm" where
  "substNegInfinity var (Eq p) = allZero p var " |
  "substNegInfinity var (Less p) = alternateNegInfinity p var"|
  "substNegInfinity var (Leq p) = Or (alternateNegInfinity p var) (allZero p var)"|
  "substNegInfinity var (Neq p) = Neg (allZero p var)"

(*
  convertDerivative var p
  is equivalent to p^+ < 0 defined on page 615 around variable var
*)
function convertDerivative :: "nat ⇒ real mpoly ⇒ atom fm" where
  "convertDerivative var p = (if (MPoly_Type.degree p var) = 0 then Atom (Less p) else
  Or (Atom (Less p)) (And (Atom(Eq p)) (convertDerivative var (derivative var p))))"
  by pat_completeness auto
termination
  apply(relation "measures [λ(var,p). MPoly_Type.degree p var]")
  apply auto
  using degree_derivative
  by (metis less_add_one)

(*
  substInfinitesimalLinear var b c A
  substitutes -c/b+epsilon for variable var in atom A
  assumes b is nonzero
  defined in page 615
*)
fun substInfinitesimalLinear :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom fm" where
  "substInfinitesimalLinear var b c (Eq p) = allZero p var"|
  "substInfinitesimalLinear var b c (Less p) = 
  liftmap
    (λx. λA. Atom(linear_substitution (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A)) 
    (convertDerivative var p)
    0"|
  "substInfinitesimalLinear var b c (Leq p) = 
Or
  (allZero p var)
  (liftmap
    (λx. λA. Atom(linear_substitution (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A)) 
    (convertDerivative var p)
    0)"|
  "substInfinitesimalLinear var b c (Neq p) = neg (allZero p var)"

(*
  substInfinitesimalQuadratic var a b c A
  substitutes (quadratic equation)+epsilon for variable var in atom A
  assumes a is nonzero and the determinant is positive
  defined in page 615
*)
fun substInfinitesimalQuadratic :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom fm" where
  "substInfinitesimalQuadratic var a b c d (Eq p) = allZero p var"|
  "substInfinitesimalQuadratic var a b c d (Less p) = quadratic_sub_fm var a b c d (convertDerivative var p)"|
  "substInfinitesimalQuadratic var a b c d (Leq p) = 
Or
  (allZero p var)
  (quadratic_sub_fm var a b c d (convertDerivative var p))"|
  "substInfinitesimalQuadratic var a b c d (Neq p) = neg (allZero p var)"


fun substInfinitesimalLinear_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where
  "substInfinitesimalLinear_fm var b c F = liftmap (λx.λA. substInfinitesimalLinear (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A) F 0"


fun substInfinitesimalQuadratic_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where
  "substInfinitesimalQuadratic_fm var a b c d F = liftmap (λx.λA. substInfinitesimalQuadratic (var+x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A) F 0"

subsection "VS Algorithms"

text
  "elimVar var L F
  attempts to do quadratic elimination on the variable defined by var.
  L is the list of conjuctive atoms, F is a list of unnecessary garbage"
fun elimVar :: "nat ⇒ atom list ⇒ (atom fm) list ⇒ atom ⇒ atom fm" where
  "elimVar var L F (Eq p) =  (
  let (a,b,c) = get_coeffs var p in

   (Or 
      
      (And (And (Atom (Eq a)) (Atom (Neq b)))
      (list_conj (
        (map (λa. Atom (linear_substitution var (-c) b a)) L)@
        (map (linear_substitution_fm var (-c) b) F)
        )))
      

      (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c)))
        (Or (list_conj (
        (map (quadratic_sub var (-b) 1 (b^2-4*a*c) (2*a)) L)@
        (map (quadratic_sub_fm var (-b) 1 (b^2-4*a*c) (2*a)) F)
        ))
        (list_conj (
        (map (quadratic_sub var (-b) (-1) (b^2-4*a*c) (2*a)) L)@
        (map (quadratic_sub_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F)
        ))
       ))
      ))

)" |
  "elimVar var L F (Less p) =  (
  let (a,b,c) = get_coeffs var p in
    (Or 
      
      (And (And (Atom (Eq a)) (Atom (Neq b)))
      (list_conj (
          (map (substInfinitesimalLinear var (-c) b) L)
          @(map (substInfinitesimalLinear_fm var (-c) b) F)
      )))
      

      (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c)))
        (Or (list_conj (
        (map (substInfinitesimalQuadratic var (-b) 1 (b^2-4*a*c) (2*a)) L)@
        (map (substInfinitesimalQuadratic_fm var (-b) 1 (b^2-4*a*c) (2*a)) F)
        ))
        (list_conj (
        (map (substInfinitesimalQuadratic var (-b) (-1) (b^2-4*a*c) (2*a)) L)@
        (map (substInfinitesimalQuadratic_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F)
        ))
       ))
      ))
)"|
  "elimVar var L F (Neq p) =  (
  let (a,b,c) = get_coeffs var p in
    (Or 
      
      (And (And (Atom (Eq a)) (Atom (Neq b)))
      (list_conj (
          (map (substInfinitesimalLinear var (-c) b) L)
          @(map (substInfinitesimalLinear_fm var (-c) b) F)
      )))
      

      (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c)))
        (Or (list_conj (
        (map (substInfinitesimalQuadratic var (-b) 1 (b^2-4*a*c) (2*a)) L)@
        (map (substInfinitesimalQuadratic_fm var (-b) 1 (b^2-4*a*c) (2*a)) F)
        ))
        (list_conj (
        (map (substInfinitesimalQuadratic var (-b) (-1) (b^2-4*a*c) (2*a)) L)@
        (map (substInfinitesimalQuadratic_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F)
        ))
       ))
      )))
"|
  "elimVar var L F (Leq p) =  (
  let (a,b,c) = get_coeffs var p in

   (Or 
      
      (And (And (Atom (Eq a)) (Atom (Neq b)))
      (list_conj (
        (map (λa. Atom (linear_substitution var (-c) b a)) L)@
        (map (linear_substitution_fm var (-c) b) F)
        )))
      

      (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c)))
        (Or (list_conj (
        (map (quadratic_sub var (-b) 1 (b^2-4*a*c) (2*a)) L)@
        (map (quadratic_sub_fm var (-b) 1 (b^2-4*a*c) (2*a)) F)
        ))
        (list_conj (
        (map (quadratic_sub var (-b) (-1) (b^2-4*a*c) (2*a)) L)@
        (map (quadratic_sub_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F)
        ))
       ))
      ))

)"

(* single virtual substitution of equality *)
fun qe_eq_one :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "qe_eq_one var L F = 
    (case find_eq var L of 
        (p#A,L') ⇒ Or (And (Neg (split_p var p))
                      ((elimVar var L F) (Eq p))
                    )
                    (And (split_p var p) 
                      (list_conj (map Atom ((map Eq A)  @ L') @ F))
                    )
      | ([],L') ⇒ list_conj ((map Atom L) @ F)
)"


fun check_nonzero_const :: "real mpoly ⇒ bool"where
  "check_nonzero_const p = (case get_if_const p of Some x ⇒ x ≠ 0 | None ⇒ False)"

fun find_lucky_eq :: "nat ⇒ atom list ⇒ real mpoly option"where
  "find_lucky_eq v [] = None"|
  "find_lucky_eq v (Eq p#L) = 
(let (a,b,c) = get_coeffs v p in
(if (MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2) ∧ (check_nonzero_const a ∨ check_nonzero_const b ∨ check_nonzero_const c) then Some p else
find_lucky_eq v L
))"|
  "find_lucky_eq v (_#L) = find_lucky_eq v L"


fun luckyFind :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm option" where
  "luckyFind v L F = (case find_lucky_eq v L of Some p ⇒ Some ((elimVar v L F) (Eq p)) | None ⇒ None)"

fun luckyFind' :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "luckyFind' v L F = (case find_lucky_eq v L of Some p ⇒ (elimVar v L F) (Eq p) | None ⇒ And (list_conj (map Atom L)) (list_conj F))"


fun find_luckiest_eq :: "nat ⇒ atom list ⇒ real mpoly option"where
  "find_luckiest_eq v [] = None"|
  "find_luckiest_eq v (Eq p#L) = 
(if (MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2) then
(let (a,b,c) = get_coeffs v p in
 (case get_if_const a of None ⇒ find_luckiest_eq v L
 | Some a ⇒ (case get_if_const b of None ⇒ find_luckiest_eq v L
 | Some b ⇒ (case get_if_const c of None ⇒ find_luckiest_eq v L
 | Some c ⇒ if a≠0∨b≠0∨c≠0 then Some p else find_luckiest_eq v L))))
 else
find_luckiest_eq v L
)"|
  "find_luckiest_eq v (_#L) = find_luckiest_eq v L"



fun luckiestFind :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "luckiestFind v L F = (case find_luckiest_eq v L of Some p ⇒ (elimVar v L F) (Eq p) | None ⇒ And (list_conj (map Atom L)) (list_conj F))"


primrec qe_eq_repeat_helper :: "nat ⇒ real mpoly list ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "qe_eq_repeat_helper var [] L F = list_conj ((map Atom L) @ F)"|
  "qe_eq_repeat_helper var (p#A) L F = 
  Or (And (Neg (split_p var p))
    ((elimVar var ((map Eq (p#A)) @ L) F) (Eq p))
  )
  (And (split_p var p) 
    (qe_eq_repeat_helper var A L F)
  )"

fun qe_eq_repeat :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "qe_eq_repeat var L F = 
    (case luckyFind var L F of Some(F) ⇒ F | None ⇒ 
    (let (A,L') = find_eq var L in
      qe_eq_repeat_helper var A L' F 
)
)
"

fun all_degree_2 :: "nat ⇒ atom list ⇒ bool" where
  "all_degree_2 var [] = True"|
  "all_degree_2 var (Eq p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"|
  "all_degree_2 var (Less p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"|
  "all_degree_2 var (Leq p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"|
  "all_degree_2 var (Neq p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"

fun gen_qe :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "gen_qe var L F = (case F of 
[] ⇒ (case luckyFind var L [] of Some F ⇒ F | None ⇒ (
    (if all_degree_2 var L 
      then list_disj (list_conj (map (substNegInfinity var) L) # (map (elimVar var L []) L)) 
  else (qe_eq_repeat var L []))))
| _ ⇒ qe_eq_repeat var L F
)"

subsection "DNF"

fun dnf :: "atom fm ⇒ (atom list * atom fm list) list" where
  "dnf TrueF = [([],[])]" |
  "dnf FalseF = []" |
  "dnf (Atom φ) = [([φ],[])]" |
  "dnf (And φ1 φ2) = [(A@B,A'@B').(A,A')←dnf φ1,(B,B')←dnf φ2]" |
  "dnf (Or φ1 φ2) = dnf φ1 @ dnf φ2" |
  "dnf (ExQ φ) = [([],[ExQ φ])]" |
  "dnf (Neg φ) = [([],[Neg φ])]"|
  "dnf (AllQ φ) = [([],[AllQ φ])]"|
  "dnf (AllN i φ) = [([],[AllN i φ])]"|
  "dnf (ExN i φ) = [([],[ExN i φ])]"

text "
  dnf F
  returns the \"disjunctive normal form\" of F, but since F can contain quantifiers, we return
  (L,R,n) terms in a list. each term in the list represents a conjunction over the outside disjunctive list
    
  L is all the atoms we are able to reach, we are allowed to go underneath exists binders
  
  R is the remaining formulas (negation exists cannot be simplified) which are also under the same number
      of exist binders.

  n is the total number of binders each conjunct has
"
fun dnf_modified :: "atom fm ⇒ (atom list * atom fm list * nat) list" where
  "dnf_modified TrueF = [([],[],0)]" |
  "dnf_modified FalseF = []" |
  "dnf_modified (Atom φ) = [([φ],[],0)]" |
  "dnf_modified (And φ1 φ2) = [
  let A = map (liftAtom d1 d2) A in
  let B = map (liftAtom 0 d1) B in
  let A' = map (liftFm d1 d2) A' in
  let B' = map (liftFm 0 d1) B' in
    (A @ B, A' @ B',d1+d2).
  (A,A',d1) ← dnf_modified φ1, (B,B',d2) ← dnf_modified φ2]" |
  "dnf_modified (Or φ1 φ2) = dnf_modified φ1 @ dnf_modified φ2" |
  "dnf_modified (ExQ φ) = [(A,A',d+1). (A,A',d) ← dnf_modified φ]" |
  "dnf_modified (Neg φ) = [([],[Neg φ],0)]"|
  "dnf_modified (AllQ φ) = [([],[AllQ φ],0)]"|
  "dnf_modified (AllN i φ) = [([],[AllN i φ],0)]"|
  "dnf_modified (ExN i φ) = [(A,A',d+i). (A,A',d) ← dnf_modified φ]"


(*
repeatedly applies nnf and dnf on subformulas and then attempts to eliminate the quantifier based
on the qe quantifier elimination method given. Works on innermost variables first and builds out
*)
fun QE_dnf :: "(atom fm ⇒ atom fm) ⇒ (nat ⇒ nat ⇒ atom list ⇒ atom fm list ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where
  "QE_dnf opt step (And φ1 φ2) = and (QE_dnf opt step φ1) (QE_dnf opt step φ2)" |
  "QE_dnf opt step (Or φ1 φ2) = or (QE_dnf opt step φ1) (QE_dnf opt step φ2)" |
  "QE_dnf opt step (Neg φ) = neg(QE_dnf opt step φ)" |
  "QE_dnf opt step (ExQ φ) = list_disj [ExN (n+1) (step 1 n al fl). (al,fl,n)←(dnf_modified(opt(QE_dnf opt step φ)))]"|
  "QE_dnf opt step (TrueF) = TrueF"|
  "QE_dnf opt step (FalseF) = FalseF"|
  "QE_dnf opt step (Atom a) = simp_atom a"|
  "QE_dnf opt step (AllQ φ) = Neg(list_disj [ExN (n+1) (step 1 n al fl). (al,fl,n)←(dnf_modified(opt(neg(QE_dnf opt step φ))))])"|
  "QE_dnf opt step (ExN 0 φ) = QE_dnf opt step φ"|
  "QE_dnf opt step (AllN 0 φ) = QE_dnf opt step φ"|
  "QE_dnf opt step (AllN (Suc i) φ) = Neg(list_disj [ExN (n+i+1) (step (Suc i) (n+i) al fl). (al,fl,n)←(dnf_modified(opt(neg(QE_dnf opt step φ))))])"|
  "QE_dnf opt step (ExN (Suc i) φ) = list_disj [ExN (n+i+1) (step (Suc i) (n+i) al fl). (al,fl,n)←(dnf_modified(opt(QE_dnf opt step φ)))]"

fun QE_dnf' :: "(atom fm ⇒ atom fm) ⇒ (nat ⇒ (atom list * atom fm list * nat) list  ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where 
  "QE_dnf' opt step (And φ1 φ2) = and (QE_dnf' opt step φ1) (QE_dnf' opt step φ2)" |
  "QE_dnf' opt step (Or φ1 φ2) = or (QE_dnf' opt step φ1) (QE_dnf' opt step φ2)" |
  "QE_dnf' opt step (Neg φ) = neg(QE_dnf' opt step φ)" |
  "QE_dnf' opt step (ExQ φ) = step 1 (dnf_modified(opt(QE_dnf' opt step φ)))"|
  "QE_dnf' opt step (TrueF) = TrueF"|
  "QE_dnf' opt step (FalseF) = FalseF"|
  "QE_dnf' opt step (Atom a) = simp_atom a"|
  "QE_dnf' opt step (AllQ φ) = Neg(step 1 (dnf_modified(opt(neg(QE_dnf' opt step φ)))))"|
  "QE_dnf' opt step (ExN 0 φ) = QE_dnf' opt step φ"|
  "QE_dnf' opt step (AllN 0 φ) = QE_dnf' opt step φ"|
  "QE_dnf' opt step (AllN (Suc i) φ) = Neg(step  (Suc i) (dnf_modified(opt(neg(QE_dnf' opt step φ)))))"|
  "QE_dnf' opt step (ExN (Suc i) φ) = step (Suc i) (dnf_modified(opt(QE_dnf' opt step φ)))"

subsection "Repeat QE multiple times"

fun countQuantifiers :: "atom fm ⇒ nat" where
  "countQuantifiers (Atom _) = 0"|
  "countQuantifiers (TrueF) = 0"|
  "countQuantifiers (FalseF) = 0"|
  "countQuantifiers (And a b) = countQuantifiers a + countQuantifiers b"|
  "countQuantifiers (Or a b) = countQuantifiers a + countQuantifiers b"|
  "countQuantifiers (Neg a) = countQuantifiers a"|
  "countQuantifiers (ExQ a) = countQuantifiers a + 1"|
  "countQuantifiers (AllQ a) = countQuantifiers a + 1"|
  "countQuantifiers (ExN n a) = countQuantifiers a + n"|
  "countQuantifiers (AllN n a) = countQuantifiers a + n"

fun repeatAmountOfQuantifiers_helper :: "(atom fm ⇒ atom fm) ⇒ nat ⇒ atom fm ⇒ atom fm" where
  "repeatAmountOfQuantifiers_helper step 0 F = F"|
  "repeatAmountOfQuantifiers_helper step (Suc i) F = repeatAmountOfQuantifiers_helper step i (step F)"

fun repeatAmountOfQuantifiers :: "(atom fm ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where
  "repeatAmountOfQuantifiers step F = (
let F = step F in
let n = countQuantifiers F in
repeatAmountOfQuantifiers_helper step n F
)"

end

Theory Heuristic

subsection "Heuristic Algorithms"
theory Heuristic
  imports VSAlgos Reindex Optimizations
begin
fun IdentityHeuristic :: "nat ⇒ atom list ⇒ atom fm list ⇒ nat" where
  "IdentityHeuristic n _ _ = n"

fun step_augment :: "(nat ⇒ atom list ⇒ atom fm list ⇒ atom fm) ⇒ (nat ⇒ atom list ⇒ atom fm list ⇒ nat) ⇒ nat ⇒ nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "step_augment step heuristic 0 var L F = list_conj (map fm.Atom L @ F)" |
  "step_augment step heuristic (Suc 0) 0 L F = step 0 L F" |
  "step_augment step heuristic _ 0 L F = list_conj (map fm.Atom L @ F)" |
  "step_augment step heuristic (Suc amount) (Suc i) L F =(
  let var = heuristic (Suc i) L F in
  let swappedL = map (swap_atom (i+1) var) L in
  let swappedF = map (swap_fm (i+1) var) F in
 list_disj[step_augment step heuristic amount i al fl. (al,fl)<-dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (i+1) swappedL swappedF))])"


fun the_real_step_augment :: "(nat ⇒ atom list ⇒ atom fm list ⇒ atom fm) ⇒ nat ⇒ (atom list * atom fm list * nat) list ⇒ atom fm" where
  "the_real_step_augment step 0 F = list_disj (map (λ(L,F,n). ExN n (list_conj (map fm.Atom L @ F))) F)" |
  "the_real_step_augment step (Suc amount) F =(
 ExQ (the_real_step_augment step amount (dnf_modified ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(list_disj(map (λ(L,F,n). ExN n (step (n+amount) L F)) F))))))"


fun aquireData :: "nat ⇒ atom list ⇒ (nat fset*nat fset*nat fset)"where
  "aquireData n L = fold (λA (l,e,g). 
 case A of
  Eq p ⇒ 
  (
    funion l (fset_of_list(filter (λv. let (a,b,c) = get_coeffs v p in
    ((MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2) ∧ (check_nonzero_const a ∨ check_nonzero_const b ∨ check_nonzero_const c))) [0..<(n+1)])),
  funion e (fset_of_list(filter (λv.(MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2)) [0..<(n+1)]))
  ,ffilter (λv. MPoly_Type.degree p v ≤ 2) g)
 | Leq p ⇒ (l,e,ffilter (λv. MPoly_Type.degree p v ≤ 2) g)
 | Neq p ⇒ (l,e,ffilter (λv. MPoly_Type.degree p v ≤ 2) g)
 | Less p ⇒ (l,e,ffilter (λv. MPoly_Type.degree p v ≤ 2) g)
) L (fempty,fempty,fset_of_list [0..<(n+1)])"


datatype natpair = Pair "nat*nat"

instantiation natpair :: linorder 
begin
definition [simp]: "less_eq (A::natpair) B = (case A of Pair(a,b) ⇒ (case B of Pair(c,d) ⇒ if a=c then b≤d else a<c))"
definition [simp]: "less (A::natpair) B = (case A of Pair(a,b) ⇒ (case B of Pair(c,d) ⇒ if a=c then b<d else a<c))"
instance proof
  fix x :: natpair
  fix y :: natpair
  fix z :: natpair
  obtain a b where x : "x = Pair (a,b)" apply(cases x) by auto
  obtain c d where y : "y = Pair (c,d)" apply(cases y) by auto
  obtain e f where z : "z = Pair (e,f)" apply(cases z) by auto
  show "(x < y) = strict (≤) x y"
    unfolding x y by auto
  show "x≤x" unfolding x by auto
  show "x≤ y ⟹ y≤ z ⟹ x≤ z" unfolding x y z apply auto
    apply (metis dual_order.trans not_less_iff_gr_or_eq)
    by (metis less_trans)
  show "x ≤ y ⟹ y ≤ x ⟹ x = y" unfolding x y apply auto
    apply (metis not_less_iff_gr_or_eq)
    by (metis antisym_conv not_less_iff_gr_or_eq)
  show "x ≤ y ∨ y ≤ x" unfolding x y by auto
qed
end

fun getBest :: "nat fset ⇒ atom list ⇒ nat option" where
  "getBest S L = (let X =  fset_of_list(map (λx. Pair(count_list (map (λl. case l of
   Eq p   ⇒ MPoly_Type.degree p x = 0
|  Less p ⇒ MPoly_Type.degree p x = 0
|  Neq p  ⇒ MPoly_Type.degree p x = 0
|  Leq p  ⇒ MPoly_Type.degree p x = 0
) L) False,x)) (sorted_list_of_fset S)) in
(case (sorted_list_of_fset X) of [] ⇒ None | Cons (Pair(x,v)) _ ⇒ Some v))
"

fun heuristicPicker :: "nat ⇒ atom list ⇒ atom fm list ⇒ (nat*(nat ⇒ atom list ⇒ atom fm list ⇒ atom fm)) option"where
  "heuristicPicker n L F = (case (let (l,e,g) = aquireData n L in
(case getBest l L of
  None ⇒ (case F of 
  [] ⇒ 
    (case getBest g L of 
    None ⇒ (case getBest e L of None ⇒ None | Some v ⇒ Some(v,qe_eq_repeat))
    | Some v ⇒ Some(v,gen_qe)
    )
  | _ ⇒ (case getBest e L of None ⇒ None | Some v ⇒ Some(v,qe_eq_repeat))
  )
| Some v ⇒ Some(v,luckyFind')
)) of None => None | Some(var,step) => (if var > n then None else Some(var,step)))"


fun superPicker :: "nat ⇒ nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where
  "superPicker 0 var L F = list_conj (map fm.Atom L @ F)"|
  "superPicker amount 0 L F = (case heuristicPicker 0 L F of Some(0,step) ⇒ step 0 L F | _ ⇒ list_conj (map fm.Atom L @ F))" |
  "superPicker (Suc amount) (Suc i) L F =(
  case heuristicPicker (Suc i) L F of
   Some(var,step) ⇒
    let swappedL = map (swap_atom (i+1) var) L in
    let swappedF = map (swap_fm (i+1) var) F in
    list_disj[superPicker amount i al fl. (al,fl)<-dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (i+1) swappedL swappedF))]
  | None ⇒ list_conj (map fm.Atom L @ F))"


datatype quadnat = Quad "nat × nat × nat × nat"

instantiation quadnat :: linorder begin
definition [simp]:"A<B =
  (case A of  Quad(a1,b1,c1,d1) ⇒ (case B of Quad(a2,b2,c2,d2) ⇒
  (if a1=a2 then (
    if b1=b2 then (
      if c1=c2 then d1<d2 else c1<c2
    ) else b1<b2
  ) else a1<a2)))"
definition [simp]:"A≤B =
  (case A of  Quad(a1,b1,c1,d1) ⇒ (case B of Quad(a2,b2,c2,d2) ⇒
  (if a1=a2 then (
    if b1=b2 then (
      if c1=c2 then d1≤d2 else c1<c2
    ) else b1<b2
  ) else a1<a2)))"
instance proof
  fix x y z
  obtain a1 b1 c1 d1 where x : "x = Quad(a1,b1,c1,d1)"
    by (metis prod_cases4 quadnat.exhaust) 
  obtain a2 b2 c2 d2 where y : "y = Quad(a2,b2,c2,d2)"
    by (metis prod_cases4 quadnat.exhaust) 
  obtain a3 b3 c3 d3 where z : "z = Quad(a3,b3,c3,d3)"
    by (metis prod_cases4 quadnat.exhaust) 
  show "(x < y) = strict (≤) x y" unfolding x y by auto
  show "x ≤ x" unfolding x by auto
  show "x ≤ y ⟹ y ≤ z ⟹ x ≤ z" unfolding x y z apply auto
    apply (metis dual_order.trans not_less_iff_gr_or_eq)
    apply (metis less_trans)
    apply (metis dual_order.strict_trans not_less_iff_gr_or_eq)
    apply (metis less_trans)
    apply (metis dual_order.strict_trans not_less_iff_gr_or_eq)
    apply (metis less_trans)
    apply (metis less_trans not_less_iff_gr_or_eq)
    by (metis less_trans)
  show "x ≤ y ⟹ y ≤ x ⟹ x = y" unfolding x y apply auto
    apply (metis less_imp_not_less)
    apply (metis not_less_iff_gr_or_eq)
    apply (metis not_less_iff_gr_or_eq)
    by (metis antisym_conv not_less_iff_gr_or_eq)
  show "x ≤ y ∨ y ≤ x" unfolding x y by auto
qed
end

fun brownsHeuristic :: "nat ⇒ atom list ⇒ atom fm list ⇒ nat" where
  "brownsHeuristic n L _ = (case sorted_list_of_fset (fset_of_list (map (λx.
  case (foldl (λ(maxdeg,totaldeg,appearancecount) l. 
  let p = case l of Eq p ⇒ p | Less p ⇒ p | Leq p ⇒ p | Neq p ⇒ p in
  let deg = MPoly_Type.degree p x in
  (max maxdeg deg,totaldeg+deg,appearancecount+(if deg>0 then 1 else 0))) (0,0,0) L) of (a,b,c) ⇒ Quad(a,b,c,x)
 ) [0..<n])) of [] ⇒ n | Cons (Quad(_,_,_,x)) _ ⇒ if x>n then n else x)"


end

Theory PrettyPrinting

theory PrettyPrinting
  imports
    ExecutiblePolyProps
    PolyAtoms
    Polynomials.Show_Polynomials
    Polynomials.Power_Products
begin

global_interpretation drlex_pm: linorder drlex_pm drlex_pm_strict
  defines Min_drlex_pm = "linorder.Min drlex_pm"
    and Max_drlex_pm = "linorder.Max drlex_pm"
    and sorted_drlex_pm = "linorder.sorted drlex_pm"
    and sorted_list_of_set_drlex_pm = "linorder.sorted_list_of_set drlex_pm"
    and sort_key_drlex_pm = "linorder.sort_key drlex_pm"
    and insort_key_drlex_pm = "linorder.insort_key drlex_pm"
    and part_drlex_pm = "drlex_pm.part"
  apply unfold_locales
  subgoal by (simp add: drlex_pm_strict_def)
  subgoal by (simp add: drlex_pm_refl)
  subgoal using drlex_pm_trans by auto
  subgoal by (simp add: drlex_pm_antisym)
  subgoal by (simp add: drlex_pm_lin) 
  done

definition "monomials_list mp = drlex_pm.sorted_list_of_set (monomials mp)"

definition shows_monomial_gen::"((nat × nat) ⇒ shows) ⇒ ('a ⇒ shows) ⇒ shows ⇒ (nat ⇒0 nat) ⇒ 'a option ⇒ shows" where
  "shows_monomial_gen shows_factor shows_coeff sep mon cff =
    shows_sep (λs. case s of
        Inl cff ⇒ shows_coeff cff
      | Inr factor ⇒ shows_factor factor
    ) sep ((case cff of None ⇒ [] | Some cff ⇒ [Inl cff]) @ map Inr (Poly_Mapping.items mon))"

definition "shows_factor_compact factor =
  (case factor of (k, v) ⇒ shows_string ''x'' +@+ shows k +@+
    (if v = 1 then shows_string '''' else shows_string ''^'' +@+ shows v))"

definition "shows_factor_Var factor =
  (case factor of (k, v) ⇒ shows_string ''(Var '' +@+ shows k +@+ shows_string '')'' +@+
    (if v = 1 then shows_string '''' else shows_string ''^'' +@+ shows v))"

definition shows_monomial_compact::"('a ⇒ shows) ⇒ (nat ⇒0 nat) ⇒ 'a option ⇒ shows" where
  "shows_monomial_compact shows_coeff m =
    shows_monomial_gen shows_factor_compact shows_coeff (shows_string '' '') m"

definition shows_monomial_Var::"('a ⇒ shows) ⇒ (nat ⇒0 nat) ⇒ 'a option ⇒ shows" where
  "shows_monomial_Var shows_coeff m =
    shows_monomial_gen shows_factor_Var shows_coeff (shows_string ''*'') m"

fun shows_mpoly :: "bool ⇒ ('a ⇒ shows) ⇒ 'a::{zero,one} mpoly ⇒ shows" where
  "shows_mpoly input shows_coeff p = shows_sep (λmon.
    (if input then shows_monomial_Var (λx. shows_paren (shows_string ''Const '' +@+ shows_paren (shows_coeff x))) else shows_monomial_compact shows_coeff)
      mon
      (let cff = MPoly_Type.coeff p mon in if cff = 1 then None else Some cff)
  )
    (shows_string '' + '')
    (monomials_list p)"


definition "rat_of_real (x::real) =
  (if (∃r::rat. x = of_rat r) then (THE r. x = of_rat r) else 99999999999.99999999999)"

lemma rat_of_real: "rat_of_real x = r" if "x = of_rat r"
  using that
  unfolding rat_of_real_def
  by simp

lemma rat_of_real_code[code]: "rat_of_real (Ratreal r) = r"
  by (simp add: rat_of_real)

definition "shows_real x = shows (rat_of_real x)"

experiment begin
abbreviation "foo ≡ ((Var 0::real mpoly) + Const (0.5) * Var 1 + Var 2)^3"
value [code] "shows_mpoly True shows_real foo ''''"
  (* rhs of foo\\_eq is the output of this ‹value› command *)
lemma foo_eq: "foo = (Var 0)^3 + (Const (3/2))*(Var 0)^2*(Var 1) + (Const (3))*(Var 0)^2*(Var 2) + (Const (3/4))*(Var 0)*(Var 1)^2 + (Const (3))*(Var 0)*(Var 1)*(Var 2) + (Const (3))*(Var 0)*(Var 2)^2 + (Const (1/8))*(Var 1)^3 + (Const (3/4))*(Var 1)^2*(Var 2) + (Const (3/2))*(Var 1)*(Var 2)^2 + (Var 2)^3"
  by code_simp
value [code] "shows_mpoly False shows_real foo ''''"
value [code] "shows_mpoly False (shows_paren o shows_mpoly False shows_real) (extract_var foo 0) ''''"
value [code] "shows_list_gen (shows_mpoly False shows_real)
  ''[]'' ''['' '', '' '']''
   (Polynomial.coeffs (mpoly_to_nested_poly foo 0)) ''''"
end

fun shows_atom :: "bool ⇒ atom ⇒ shows" where
  "shows_atom c (Eq p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''=0)'')"|
  "shows_atom c (Less p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''<0)'')"|
  "shows_atom c (Leq p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''<=0)'')"|
  "shows_atom c(Neq p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''~=0)'')"

fun depth' :: "'a fm ⇒ nat"where
  "depth' TrueF = 1"|
  "depth' FalseF = 1"|
  "depth' (Atom _) = 1"|
  "depth' (And φ ψ) = max (depth' φ) (depth' ψ) + 1"|
  "depth' (Or φ ψ) = max (depth' φ) (depth' ψ) + 1"|
  "depth' (Neg φ) = depth' φ + 1"|
  "depth' (ExQ φ) = depth' φ + 1"|
  "depth' (AllQ φ) = depth' φ + 1"|
  "depth' (AllN i φ) = depth' φ  + i * 2 + 1"|
  "depth' (ExN i φ) = depth' φ  + i * 2 + 1"


function shows_fm :: "bool ⇒ atom fm ⇒ shows" where
  "shows_fm c (Atom a) = shows_atom c a"|
  "shows_fm c (TrueF) = shows_string ''(T)''"|
  "shows_fm c (FalseF) = shows_string ''(F)''"|
  "shows_fm c (And φ ψ) = (shows_string ''('' +@+ shows_fm c φ +@+ shows_string '' and '' +@+ shows_fm c ψ +@+ shows_string ('')''))"|
  "shows_fm c (Or φ ψ) = (shows_string ''('' +@+ shows_fm c φ +@+ shows_string '' or '' +@+ shows_fm c ψ  +@+ shows_string '')'')"|
  "shows_fm c (Neg φ) = (shows_string ''(neg '' +@+ shows_fm c φ +@+ shows_string '')'')"|
  "shows_fm c (ExQ φ) = (shows_string ''(exists'' +@+ shows_fm c φ +@+ shows_string '')'')"|
  "shows_fm c (AllQ φ) = (shows_string ''(forall'' +@+ shows_fm c φ +@+ shows_string '')'')"|
  "shows_fm c (ExN 0 φ) = shows_fm c φ"|
  "shows_fm c (ExN (Suc n) φ) = shows_fm c (ExQ(ExN n φ))"|
  "shows_fm c (AllN 0 φ) = shows_fm c φ"|
  "shows_fm c (AllN (Suc n) φ) = shows_fm c (AllQ(AllN n φ))"
  by pat_completeness auto
termination
  apply(relation "measures [λ(_,A). depth' A]")
  by auto


value "shows_fm False (ExQ (Or (AllQ(And (Neg TrueF) (Neg FalseF))) (Atom(Eq(Const 4))))) []"
value "shows_fm True (ExQ (Or (AllQ(And (Neg TrueF) (Neg FalseF))) (Atom(Eq(Const 4))))) []"

end

Theory Exports

subsection "Top-Level Algorithms"
theory Exports
  imports Heuristic VSAlgos Optimizations
    (*"HOL-Library.Code_Real_Approx_By_Float"*)
    HOL.String "HOL-Library.Code_Target_Int" "HOL-Library.Code_Target_Nat" PrettyPrinting Show.Show_Real
begin


definition "opt = (push_forall ∘ nnf ∘ unpower 0 o clearQuantifiers)"
definition "opt_group = (push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)"

definition "VSLuckiest = opt o (QE_dnf opt (λamount. luckiestFind)) o opt"
definition "VSLuckiestBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment luckiestFind)) o  opt_group"
definition "VSEquality =opt o (QE_dnf opt(λx. qe_eq_repeat)) o VSLuckiest o opt "
definition "VSEqualityBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment qe_eq_repeat)) o VSLuckiestBlocks o opt_group"
definition "VSGeneralBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment gen_qe))o VSLuckiestBlocks o opt_group"
definition "VSLuckyBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment luckyFind'))o VSLuckiestBlocks o opt_group"
definition "VSLEGBlocks = VSGeneralBlocks o VSEqualityBlocks o VSLuckyBlocks"
definition "VSEqualityBlocksLimited =opt_group o (QE_dnf opt_group (step_augment qe_eq_repeat IdentityHeuristic)) o VSLuckiestBlocks o opt_group"
definition "VSEquality_3_times = VSEquality o VSEquality o VSEquality"
definition "VSGeneral = opt o (QE_dnf opt (λx. gen_qe)) o VSLuckiest o opt"
definition "VSGeneralBlocksLimited = opt_group o (QE_dnf opt_group (step_augment gen_qe IdentityHeuristic)) o VSLuckiestBlocks o opt_group"
definition "VSBrowns = opt_group o (QE_dnf opt_group (step_augment gen_qe brownsHeuristic)) o VSLuckiestBlocks o opt_group"
definition "VSGeneral_3_times = VSGeneral o VSGeneral o VSGeneral"
definition "VSLucky = opt o (QE_dnf opt (λamount. luckyFind')) o VSLuckiest o opt"
definition "VSLuckyBlocksLimited = opt_group o (QE_dnf opt_group (step_augment luckyFind' IdentityHeuristic)) o VSLuckiestBlocks o opt_group"
definition "VSLEG = VSGeneral o VSEquality o VSLucky"
definition "VSHeuristic = opt_group o (QE_dnf opt_group (superPicker)) o VSLuckiestBlocks o opt_group"
definition "VSLuckiestRepeat = repeatAmountOfQuantifiers VSLuckiest"


definition add :: "real mpoly ⇒ real mpoly ⇒ real mpoly" where
  "add p q = p + q"

definition minus :: "real mpoly ⇒ real mpoly ⇒ real mpoly" where
  "minus p q = p - q"

definition mult :: "real mpoly ⇒ real mpoly ⇒ real mpoly" where
  "mult p q = p * q"

definition pow :: "real mpoly ⇒ integer ⇒ real mpoly" where
  "pow p n = p ^ (nat_of_integer n)"

definition C :: "real ⇒ real mpoly" where 
  "C r = Const r"

definition V :: "integer ⇒ real mpoly" where 
  "V n = Var (nat_of_integer n)"

definition real_of_int :: "integer ⇒ real"
  where "real_of_int n = real (nat_of_integer n)"

definition real_mult :: "real ⇒ real ⇒ real"
  where "real_mult n m = n * m"

definition real_div :: "real ⇒ real ⇒ real"
  where "real_div n m = n / m"

definition real_plus :: "real ⇒ real ⇒ real"
  where "real_plus n m = n + m"

definition real_minus :: "real ⇒ real ⇒ real"
  where "real_minus n m = n - m"

fun is_quantifier_free :: "atom fm ⇒ bool" where
  "is_quantifier_free (ExQ x) =False"|
  "is_quantifier_free (AllQ x) =False"|
  "is_quantifier_free (And a b) =(is_quantifier_free a ∧ is_quantifier_free b)"|
  "is_quantifier_free (Or a b) =(is_quantifier_free a ∧ is_quantifier_free b)"|
  "is_quantifier_free (Neg a) =is_quantifier_free a"|
  "is_quantifier_free a = True"

fun is_solved :: "atom fm ⇒ bool" where
  "is_solved TrueF = True"|
  "is_solved FalseF = True"|
  "is_solved A = False"

definition print_mpoly :: "(real ⇒ String.literal)⇒ real mpoly ⇒ String.literal" where
  "print_mpoly f p = String.implode ((shows_mpoly True (λx.λy. (String.explode o f) x @ y)) p '''')"

definition "Unpower = unpower 0"

export_code
  print_mpoly
  VSGeneral VSEquality VSLucky VSLEG VSLuckiest
  VSGeneralBlocksLimited VSEqualityBlocksLimited VSLuckyBlocksLimited 
  VSGeneralBlocks VSEqualityBlocks VSLuckyBlocks VSLEGBlocks VSLuckiestBlocks
  QE_dnf
  gen_qe qe_eq_repeat
  simpfm push_forall nnf Unpower
  is_quantifier_free is_solved
  add mult C V pow minus
  Eq Or is_quantifier_free 

real_of_int real_mult real_div real_plus real_minus

VSGeneral_3_times VSEquality_3_times VSHeuristic VSLuckiestRepeat VSBrowns
in SML module_name VS

end

Theory LinearCase

section "Equality VS Proofs"
subsection "Linear Case"
theory LinearCase
  imports VSAlgos
begin




theorem var_not_in_linear : 
  assumes "var ∉ vars b"
  assumes "var ∉ vars c" 
  shows "freeIn var (Atom (linear_substitution var b c A))"
proof(cases A)
  case (Less p) define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Less apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
next
  case (Eq p)
  define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Eq apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
next
  case (Leq p)
  define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Leq apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
next
  case (Neq p)
  define d where "d = MPoly_Type.degree p var"
  then show ?thesis using Neq apply simp unfolding d_def[symmetric]
    apply simp using not_in_sum
    using not_in_isovarspar assms  not_in_mult not_in_neg not_in_pow not_in_add
    by (metis (no_types, lifting))
qed

(* ----------------------------------------------------------------------------------------------- *)
lemma linear_eq :
  assumes lLength : "length L > var"
  assumes nonzero : "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes hb :  "insertion (nth_default 0 (list_update L var( B/C))) b = (B::real)"
  assumes hc : "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Eq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Eq(p))) (list_update L var v))"
proof -
  define d where "d = MPoly_Type.degree p var"
  define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i
  have h : "((∑i = 0..<d+1. f i / C ^ i) = 0) =((∑i = 0..<d+1. (f i) * C ^ (d - i)) = 0)"
    using normalize_summation nonzero by(auto)
  have "aEval (linear_substitution var b c (Eq(p))) (list_update L var (B/C)) =
    aEval (Eq(∑i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))) (list_update L var (B/C))"
    by (metis (no_types, lifting) d_def linear_substitution.simps(1) sum.cong)
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) = 0)"
    using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength)
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i/ (C ^ i)) = 0)"
    using h by(simp add: f_def)
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * ((B/C) ^ i)) = 0)"
    by (metis (no_types, lifting) power_divide sum.cong times_divide_eq_right)
  also have "... = aEval (Eq(p :: real mpoly)) (list_update L var (B/C))"
    using sum_over_degree_insertion d_def lLength by auto
  finally show ?thesis using assms plugInLinear var_not_in_linear var_not_in_eval
    by (meson var_not_in_aEval)
qed





(* -------------------------------------------------------------------------------------------- *)


lemma linear_less :
  assumes lLength : "length L > var"
  assumes nonzero : "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Less(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Less(p))) (list_update L var v))"
proof-
  define d where "d = MPoly_Type.degree p var"
  define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i
  have h : "(∑i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) < 0  ⟷ (∑i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) < 0"
    using nonzero normalize_summation_less by auto
  have "aEval (linear_substitution var b c (Less(p))) (list_update L var (B/C))=aEval (Less((∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (b^i) * (c^(d-i))) * (c ^ (d mod 2)))) (list_update L var (B/C))"
    by (metis (no_types, lifting) d_def linear_substitution.simps(2) sum.cong)
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) * C ^ (d mod 2) < 0)"
    using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength)
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (((B) ^ i) / (C ^ i))) < 0)"
    using f_def h by auto
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B/C)^i) < 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "... = aEval (Less(p)) (list_update L var (B/C))"
    using d_def sum_over_degree_insertion lLength by auto
  finally show ?thesis using assms plugInLinear var_not_in_linear var_not_in_eval
    by (meson var_not_in_aEval)
qed



(* -------------------------------------------------------------------------------------------- *)

lemma linear_leq :
  assumes lLength : "length L > var"
  assumes nonzero : "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Leq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Leq(p))) (list_update L var v))"
proof -
  define d where "d = MPoly_Type.degree p var"
  define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i
  have h1a : "((∑i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) < 0 ) = ((∑i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) < 0)"
    using nonzero normalize_summation_less by auto
  have "((∑i = 0..<d+1. f i / C ^ i) = 0) =((∑i = 0..<d+1. (f i) * C ^ (d - i)) = 0)"
    using normalize_summation nonzero by(auto)
  also have "... =((∑i = 0..<d+1. (f i) * C ^ (d - i))* C ^ (d mod 2) = 0)"
    using mult_eq_0_iff nonzero power_not_zero by blast
  finally have h1 : "((∑i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) ≤ 0 ) = ((∑i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) ≤ 0)"
    using h1a by smt 
  have "aEval (linear_substitution var b c (Leq(p))) (list_update L var (B/C))=aEval (Leq((∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (b^i) * (c^(d-i))) * (c ^ (d mod 2)))) (list_update L var (B/C))"
    by (metis (no_types, lifting) d_def linear_substitution.simps(3) sum.cong)
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) * C ^ (d mod 2) ≤ 0)"
    using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength)
  also have"...= ((∑i = 0..<(d+1). (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i) / (C ^ i)) ≤ 0)"
    using h1 f_def by auto
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (((B) ^ i) / (C ^ i))) ≤ 0)"
    by auto
  also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B/C)^i) ≤ 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have  "... = aEval (Leq(p)) (list_update L var (B/C))"
    using d_def sum_over_degree_insertion lLength by auto
  finally show ?thesis using assms plugInLinear var_not_in_eval var_not_in_linear
    by (meson var_not_in_aEval) 
qed
  (* ----------------------------------------------------------------------------------------------- *)


lemma linear_neq :
  assumes lLength : "length L > var"
  assumes nonzero : "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval (Neq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Neq(p))) (list_update L var v))"
proof -
  define d where "d = MPoly_Type.degree p var"
  have "aEval (Eq(p)) (list_update L var (B/C)) = (∀v. aEval (linear_substitution var b c (Eq(p))) (list_update L var v))"
    using linear_eq assms by auto
  also have "... = (∀v. eval (Atom (Eq ((∑i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))))) (list_update L var v))"
    by (metis (no_types, lifting) d_def eval.simps(1) linear_substitution.simps(1) sum.cong)
  also have "... = (¬(∀v. eval (Atom (Neq ((∑i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))))) (list_update L var v)))"
    by (metis (no_types, lifting) aEval.simps(1) aEval.simps(4) eval.simps(1) assms(3) assms(4) not_contains_insertion not_in_isovarspar not_in_mult not_in_pow not_in_sum)
  also have "... = (¬(∀v. aEval (linear_substitution var b c (Neq(p))) (list_update L var v)))"
    by (metis (full_types) d_def eval.simps(1) linear_substitution.simps(4))
  finally have "... = (¬(aEval (Neq(p)) (list_update L var (B/C))))" by simp
  then show ?thesis
    using assms(3) assms(4) var_not_in_aEval var_not_in_linear by blast
qed

(* -------------------------------------------------------------------------------------------- *)



theorem linear :
  assumes lLength : "length L > var"
  assumes "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "aEval A (list_update L var (B/C))  = (aEval (linear_substitution var b c A) (list_update L var v))"
  apply(cases A) using linear_less[OF assms(1-6)] linear_eq[OF assms(1-6)] linear_leq[OF assms(1-6)] linear_neq[OF assms(1-6)] by auto




lemma var_not_in_linear_fm_helper : 
  assumes "var ∉ vars b"
  assumes "var ∉ vars c" 
  shows "freeIn (var+z) (linear_substitution_fm_helper var b c F z)"
proof(induction F arbitrary: z)
  case TrueF
  then show ?case by(simp)
next
  case FalseF
  then show ?case by simp
next
  case (Atom x)
  show ?case unfolding linear_substitution_fm_helper.simps liftmap.simps
    using var_not_in_linear[OF not_in_lift[OF assms(1)] not_in_lift[OF assms(2)], of z] by blast
next
  case (And F1 F2)
  then show ?case by simp
next
  case (Or F1 F2)
  then show ?case by simp
next
  case (Neg F)
  then show ?case by simp
next
  case (ExQ F)
  show ?case using ExQ[of "z+1"] by simp
next
  case (AllQ F)
  show ?case using AllQ[of "z+1"] by simp
next
  case (ExN x1 φ)
  then show ?case
    by (metis (no_types, lifting) freeIn.simps(13) group_cancel.add1 liftmap.simps(10) linear_substitution_fm_helper.simps)
next
  case (AllN x1 φ)
  then show ?case
    by (metis (no_types, lifting) freeIn.simps(12) group_cancel.add1 liftmap.simps(9) linear_substitution_fm_helper.simps)
qed

theorem var_not_in_linear_fm : 
  assumes "var ∉ vars b"
  assumes "var ∉ vars c" 
  shows "freeIn var (linear_substitution_fm var b c F)"
  using var_not_in_linear_fm_helper[OF assms, of 0] by auto

lemma linear_fm_helper :
  assumes "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes "insertion (nth_default 0 (list_update (drop z L) var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update (drop z L) var (B/C))) c = (C::real)"
  assumes lLength : "length L > var+z"
  shows "eval F (list_update L (var+z) (B/C))  = (eval (linear_substitution_fm_helper var b c F z) (list_update L (var+z) v))"
  using assms proof(induction F arbitrary:z L)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  define L1 where "L1 = drop z L"
  define L2 where "L2 = take z L"
  have L_def : "L = L2 @ L1" using L1_def L2_def by auto
  have h1a : "insertion (nth_default 0 L1) b = B"
    using not_contains_insertion[OF Atom(2), of L1 "B/C" B] Atom(4) unfolding L1_def nth_default_def
    by (metis list_update_id)
  have lengthl2 : "length L2 = z" using L2_def
    using Atom.prems(6) min.absorb2 by auto 
  have "(∀I amount.
         length I = amount ⟶
         (∀xs. eval (fm.Atom (Eq (b - Const B))) ([] @ xs) =
               eval (liftFm 0 amount (fm.Atom (Eq (b - Const B)))) ([] @ I @ xs)))"
    by (metis eval_liftFm_helper list.size(3))
  then have "eval (Atom(Eq (b-Const B))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (b- Const B)))) ([] @ L2 @ L1)"
    using lengthl2 by auto 
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (b - Const B)) = 0)"
    apply(simp add: insertion_sub insertion_const) using h1a by auto
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z b) = B"
    using lift_minus by blast
  then have h1 : "insertion (nth_default 0 (L[var + z := B/C])) (liftPoly 0 z b) = B"
    using not_in_lift[OF Atom(2), of z] L_def
    by (metis list_update_id not_contains_insertion) 
  have h2a : "insertion (nth_default 0 L1) c = C"
    using not_contains_insertion[OF Atom(3), of L1 "B/C" C] Atom(5) unfolding L1_def
    by (metis list_update_id)
  have "(∀I amount.
         length I = amount ⟶
         (∀xs. eval (fm.Atom (Eq (c - Const C))) ([] @ xs) =
               eval (liftFm 0 amount (fm.Atom (Eq (c - Const C)))) ([] @ I @ xs)))"
    by (metis eval_liftFm_helper list.size(3))
  then have "eval (Atom(Eq (c-Const C))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (c- Const C)))) ([] @ L2 @ L1)"
    using lengthl2 by auto 
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (c - Const C)) = 0)"
    apply(simp add: insertion_sub insertion_const) using h2a by auto
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = C"
    using lift_minus by blast
  then have h2 : "insertion (nth_default 0 (L[var + z := B/C])) (liftPoly 0 z c) = C"
    using not_in_lift[OF Atom(3), of z] L_def
    by (metis list_update_id not_contains_insertion)
  show ?case using linear[OF Atom(6) Atom(1) not_in_lift[OF Atom(2)] not_in_lift[OF Atom(3)], of B, of x, OF h1 h2] unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps
    .
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)  
  then show ?case using var_not_in_linear_fm_helper var_not_in_eval unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps
    by blast
next
  case (Neg F)
  then show ?case using var_not_in_linear_fm_helper var_not_in_eval  unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps
    by blast
next
  case (ExQ F)
  have droph : "(drop (z + 1) (x#L)) = (drop z L)" for x by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (ExQ F) (L[var + z := B/C]) =
        (∃x. eval F ((x # L)[var + (z + 1) := B/C])) "
    apply(simp) unfolding l done

  also have "... = (∃x. eval
              (liftmap (λx. λa. Atom(linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) a)) F (z + 1))
              ((x # L)[var + (z + 1) := v]))"
    apply(rule ex_cong1)
    using ExQ(1)[of "z+1", OF assms(1) assms(2) assms(3)] droph
    unfolding linear_substitution_fm_helper.simps liftmap.simps
    by (metis (mono_tags, lifting) ExQ.prems(4) ExQ.prems(5) ExQ.prems(6) One_nat_def Suc_eq_plus1 Suc_less_eq add_Suc_right list.size(4))
  also have "... = (eval (linear_substitution_fm_helper var b c (ExQ F) z) (L[var + z := v]))"
    unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps l by simp
  finally show ?case by simp
next
  case (AllQ F)
  have droph : "(drop (z + 1) (x#L)) = (drop z L)" for x by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (AllQ F) (L[var + z := B/C]) =
        (∀x. eval F ((x # L)[var + (z + 1) := B/C])) "
    apply(simp) unfolding l done
  also have "... = (∀x. eval
             (liftmap (λx.λa. Atom(linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) a)) F (z + 1))
              ((x # L)[var + (z + 1) := v]))"
    apply(rule all_cong1)
    using AllQ(1)[of "z+1", OF assms(1) assms(2) assms(3)]
      var_not_in_linear_fm_helper[OF assms(2) assms(3)] var_not_in_eval droph
    unfolding linear_substitution_fm_helper.simps liftmap.simps
    by (metis (mono_tags, lifting) AllQ(7) AllQ.prems(4) AllQ.prems(5) One_nat_def Suc_eq_plus1 Suc_less_eq add_Suc_right list.size(4))
  also have "... = (eval (linear_substitution_fm_helper var b c (AllQ F) z) (L[var + z := v]))"
    unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps l by auto
  finally show ?case by simp
next
  case (ExN x1 φ)
  have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)[var := B / C]) = ((drop z L)[var := B / C])"
    by auto
  have map : "⋀ z L. eval (liftmap (λx A. fm.Atom (linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) A)) φ (z + x1))
      L = eval (liftmap (λx A. fm.Atom (linear_substitution (var + x1 + x) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) A)) φ z)
      L"
    apply(induction φ) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case
    apply simp apply(rule ex_cong1)
    subgoal for l
      using map[of z] ExN(1)[OF ExN(2-4), of "z+x1" "l@L"] ExN(5-7) list
      apply simp
      by (smt (z3) add.commute add.left_commute add_diff_cancel_left' add_mono_thms_linordered_field(4) list list_update_append not_add_less1 order_refl)
    done
next
  case (AllN x1 φ)
  have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)[var := B / C]) = ((drop z L)[var := B / C])"
    by auto
  have map : "⋀ z L. eval (liftmap (λx A. fm.Atom (linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) A)) φ (z + x1))
      L = eval (liftmap (λx A. fm.Atom (linear_substitution (var + x1 + x) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) A)) φ z)
      L"
    apply(induction φ) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case
    apply simp apply(rule all_cong1)
    subgoal for l
      using map[of z] AllN(1)[OF AllN(2-4), of "z+x1" "l@L"] AllN(5-7) list
      apply simp
      by (smt (z3) add.commute add.left_commute add_diff_cancel_left' add_mono_thms_linordered_field(4) list list_update_append not_add_less1 order_refl)
    done
qed

theorem linear_fm :
  assumes lLength : "length L > var"
  assumes "C ≠ 0"
  assumes "var ∉ vars b"
  assumes "var ∉ vars c"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)"
  assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)"
  shows "eval F (list_update L var (B/C))  = (∀v. eval (linear_substitution_fm var b c F) (list_update L var v))"
  unfolding linear_substitution_fm.simps using linear_fm_helper[OF assms(2) assms(3) assms(4), of 0 L B] assms(1) assms(5) assms(6)
  by (simp add: lLength)
end

Theory QuadraticCase

subsection "Quadratic Case"
theory QuadraticCase
  imports VSAlgos
begin

(*-------------------------------------------------------------------------------------------------------------*)
lemma quad_part_1_eq :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D ≠ 0"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Eq p) (list_update L var ((A+B*C)/D)) = aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C)"
proof - 
  define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i
  have h1 : "∀i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))"
    by(simp add: insertion_isovarspars_free)
  have h2 : "((∑i = 0..<deg+1. f i / D ^ i) = 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) = 0)"
    using normalize_summation nonzero by(auto)
  have "aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C) = 
      ((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) = 0)"
    by(simp add: hdeg insertion_sum insertion_add insertion_mult insertion_var insertion_pow ha hb hd lLength)
  also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) = 0)"
    using f_def h2 by auto
  also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) = 0)"
    by auto
  also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) = 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))=0)"
    using h1 by auto 
  also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p =0)"
    using sum_over_degree_insertion hdeg lLength by auto
  also have "... = aEval (Eq p) (list_update L var ((A+B*C)/D))"
    using aEval.simps(1) by blast
  finally show ?thesis using assms by auto
qed


(*------------------------------------------------------------------------------------------------*)
lemma quad_part_1_less :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D ≠ 0"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Less p) (list_update L var ((A+B*C)/D)) = aEval (Less(quadratic_part_1 var a b d (Less p))) (list_update L var C)"
proof - 
  define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i
  have h1a : "((∑i = 0..<deg+1. f i / D ^ i) < 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i))  * D ^ (deg mod 2) < 0)"
    using normalize_summation_less nonzero by(auto)
  have h4a : "∀i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))"
    by(simp add: insertion_isovarspars_free)
  have "((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) * D ^ (deg mod 2) < 0)
        =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) < 0)"
    using h1a f_def by auto
  also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) < 0)"
    by auto
  also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) < 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D)))  (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))<0)"
    using h4a
    by auto 
  also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p <0)"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add: hdeg lLength insertion_add insertion_mult ha hb hd insertion_sum insertion_pow insertion_var)
qed

(*------------------------------------------------------------------------------------------------*)
lemma quad_part_1_leq :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D ≠ 0"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Leq p) (list_update L var ((A+B*C)/D)) = aEval (Leq(quadratic_part_1 var a b d (Leq p))) (list_update L var C)"
proof - 
  define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i
  have h1a : "((∑i = 0..<deg+1. f i / D ^ i) < 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i))  * D ^ (deg mod 2) < 0)"
    using normalize_summation_less nonzero by(auto)
  have h1b : "((∑i = 0..<deg+1. f i / D ^ i) = 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) = 0)"
    using normalize_summation nonzero by(auto)
  have h1c : "((∑i = 0..<deg+1. f i / D ^ i) ≤ 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i))  * D ^ (deg mod 2) ≤ 0)"
    using h1a h1b nonzero by auto 
  have h4a : "∀i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))"
    by(simp add: insertion_isovarspars_free)
  have "((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) * D ^ (deg mod 2) ≤ 0)=
    ((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) ≤ 0)"
    using h1c f_def by auto
  also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) ≤ 0)"
    by auto
  also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) ≤ 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))≤0)"
    using h4a by auto 
  also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p≤0)"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add: hdeg lLength insertion_add insertion_mult ha hb hd insertion_sum insertion_pow insertion_var)
qed

(*------------------------------------------------------------------------------------------------*)
lemma quad_part_1_neq :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D ≠ 0"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Neq p) (list_update L var ((A+B*C)/D)) = aEval (Neq(quadratic_part_1 var a b d (Neq p))) (list_update L var C)"
proof -
  have "aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C) = aEval (Eq p) (list_update L var ((A+B*C)/D))"
    using quad_part_1_eq assms by blast
  then show ?thesis by auto
qed

(*------------------------------------------------------------------------------------------------*)


lemma sqrt_case : 
  assumes detGreater0 : "SQ ≥ 0"
  shows "((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i"
proof -
  have h1 : "i mod 2 = 0 ∨ (odd i ∧ (i mod 2 = 1))"
    by auto
  have h2 : "i mod 2 = 0 ⟹ ((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i"
    using detGreater0 apply auto
    by (simp add: real_sqrt_power_even)
  have h3 : "(odd i ∧ (i mod 2 = 1)) ⟹ ((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i"
    using detGreater0 apply auto
    by (smt One_nat_def add_Suc_right mult.commute nat_arith.rule0 odd_two_times_div_two_succ power.simps(2) power_mult real_sqrt_pow2)
  show ?thesis
    using h1 h2 h3
    by linarith 
qed

lemma sum_over_sqrt :
  assumes detGreater0 : "SQ ≥ 0"
  shows "(∑i∈{0..<n+1}. ((f i::real) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
        =(∑i∈{0..<n+1}. ((f i::real) * ((sqrt SQ)^i)))"
  using sqrt_case detGreater0
  by (metis (no_types, hide_lams) distrib_left mult.assoc) 

lemma quad_part_2_eq :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ≥0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Eq p) (list_update L var (sqrt SQ)) = aEval (Eq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_less :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ≥0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Less p) (list_update L var (sqrt SQ)) = aEval (Less(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_neq :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ≥0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Neq p) (list_update L var (sqrt SQ)) = aEval (Neq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_leq :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ≥0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Leq p) (list_update L var (sqrt SQ)) = aEval (Leq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_deg :
  assumes sqfree : "(var::nat)∉vars(sq::real mpoly)"
  shows "MPoly_Type.degree (quadratic_part_2 var sq p) var ≤ 1"
proof -
  define deg where "deg = MPoly_Type.degree (p::real mpoly) var"
  define f where "f i = isolate_variable_sparse p var i * sq ^ (i div 2) * Const (real (i mod 2)) * Var var" for i
  define g where "g i = isolate_variable_sparse p var i * sq ^ (i div 2) * Const (1 - real (i mod 2))" for i
  have h1a : "∀i. MPoly_Type.degree (isolate_variable_sparse p var i) var = 0"
    by (simp add: varNotIn_degree not_in_isovarspar) 
  have h1b : "∀i. MPoly_Type.degree (sq ^ (i div 2)) var = 0"
    by (simp add: sqfree varNotIn_degree not_in_pow)
  have h1c : "∀i. MPoly_Type.degree (Const (real (i mod 2))) var = 0"
    using degree_const by blast
  have h1d : "MPoly_Type.degree (Var var :: real mpoly) var = 1"
    using degree_one by auto
  have h1 : "∀i<deg+1. MPoly_Type.degree (f i) var ≤ 1"
    using f_def degree_mult h1a h1b h1c h1d
    by (smt ExecutiblePolyProps.degree_one add.right_neutral mult.commute mult_eq_0_iff nat_le_linear not_one_le_zero)
  have h2a : "∀i. MPoly_Type.degree (Const (1 - real (i mod 2))) var = 0"
    using degree_const by blast
  have h2 : "∀i<deg+1. MPoly_Type.degree (g i) var = 0"
    using g_def degree_mult h1a h1b h2a
    by (metis (no_types, lifting) add.right_neutral mult_eq_0_iff)
  have h3 : "∀i<deg+1. MPoly_Type.degree (f i + g i) var ≤ 1"
    using h1 h2 by (simp add: degree_add_leq)
  show ?thesis using atLeastLessThanSuc_atLeastAtMost degree_sum f_def g_def h3 deg_def by auto 
qed



(*------------------------------------------------------------------------------------------------*)

lemma quad_equality_helper :
  assumes lLength : "length L > var"
  assumes detGreat0 : "Cv≥0"
  assumes hC : "∀x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)"
  assumes hA : "∀x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)"
  assumes hB : "∀x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)"
  shows "aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv)) = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*C)))) (list_update L var (sqrt Cv))"
proof-
  have h1 : "∀x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h2a : "(Av + Bv * sqrt Cv = 0) = (Av = - Bv * sqrt Cv)"
    by auto
  have h2b : "(Av = - Bv * sqrt Cv) ⟹ (Av^2 = (- Bv * sqrt Cv)^2)"
    by simp
  have h2c : "(Av^2 = (- Bv * sqrt Cv)^2) = (Av^2 = Bv^2 * (sqrt Cv)^2)"
    by (simp add: power_mult_distrib)
  have h2d : "(Av^2 = Bv^2 * (sqrt Cv)^2) = (Av^2 = Bv^2 * Cv)"
    by (simp add: detGreat0)
  have h2 : "(Av + Bv * sqrt Cv = 0) ⟹ (Av^2 = Bv^2 * Cv)"
    using h2a h2b h2c h2d by blast
  have h3a : "(Av*Bv > 0) ⟹ (Av + Bv * sqrt Cv ≠ 0)"
    by (smt detGreat0 mult_nonneg_nonneg real_sqrt_ge_zero zero_less_mult_iff)
  have h3 : "(Av + Bv * sqrt Cv = 0) ⟹ (Av*Bv≤ 0)"
    using h3a by linarith
  have h4 : "(Av * Bv ≤ 0 ∧ Av2 = Bv2 * Cv) ⟹ (Av + Bv * sqrt Cv = 0)"
    apply(cases "Av>0")
     apply (metis detGreat0 h2a h2c h2d mult_minus_left not_le power2_eq_iff real_sqrt_lt_0_iff zero_less_mult_iff)
    by (smt h2a real_sqrt_abs real_sqrt_mult zero_less_mult_iff)
  show ?thesis
    apply(simp add: hA hB h1 insertion_add insertion_mult insertion_var lLength)
    using h2 h3 h4 by blast
qed

lemma quadratic_sub_eq :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Eq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Eq p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Eq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1"
    using freeC quad_part_2_deg p2_def by (meson le_neq_implies_less less_one)
  have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis 
  have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp
  have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = 
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast 
  have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast


  have "aEval (Eq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) =  aEval (Eq p1) (list_update L var (sqrt Cv))"
    using p1_def quad_part_1_eq nonzero ha hb hd lLength by blast
  also have h2 : "... = aEval (Eq p2) (list_update L var (sqrt Cv))"
    using p2_def quad_part_2_eq lLength detGreater0 hc by metis
  also have "... = aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have "... = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    using quad_equality_helper hc detGreater0 h4a h4b lLength by blast
  also have "... = eval (quadratic_sub var a b c d (Eq p)) (list_update L var (sqrt Cv))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(1) by metis
  finally show ?thesis by blast
qed
  (*------------------------------------------------------------------------------------------------*)
lemma quadratic_sub_less_helper :
  assumes lLength : "length L > var"
  assumes detGreat0 : "Cv≥0"
  assumes hC : "∀x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)"
  assumes hA : "∀x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)"
  assumes hB : "∀x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)"
  shows "aEval (Less (A + B * Var var)) (list_update L var (sqrt Cv)) = eval
     (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B2 * C - A2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A2 - B2 * C))))))
     (list_update L var (sqrt Cv)) "
proof-
  have h1 : "∀x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h2 : "∀x. insertion (nth_default 0 (list_update L var x)) ((B^2)*C-A^2) = (Bv^2)*Cv-Av^2"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h3 : "Av=0 ⟹ Bv=0 ⟹ (Av + Bv * sqrt Cv < 0) =
    (Av < 0 ∧ Bv2 * Cv < Av2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av2 < Bv2 * Cv))"
    by simp
  have h4 : "Av<0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv < 0) =
    (Av < 0 ∧ Bv2 * Cv < Av2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av2 < Bv2 * Cv))"
    by (metis add.right_neutral add_mono_thms_linordered_field(5) detGreat0 less_eq_real_def mult_less_0_iff mult_zero_class.mult_zero_left mult_zero_class.mult_zero_right real_sqrt_eq_zero_cancel_iff real_sqrt_gt_0_iff)
  have h5a : "Av≥0 ⟹ Bv≤0 ⟹ (Av < -Bv * sqrt Cv) ⟹ (Av2 < Bv2 * Cv)"
  proof -
    assume a1: "0 ≤ Av"
    assume a2: "Av < - Bv * sqrt Cv"
    assume "Bv ≤ 0"
    then have "Av < sqrt (Cv * (Bv * Bv))"
      using a2 by (simp add: mult.commute real_sqrt_mult)
    then show ?thesis
      using a1 by (metis (no_types) mult.commute power2_eq_square real_sqrt_less_iff real_sqrt_mult real_sqrt_pow2_iff)
  qed
  have h5b : "Av≥0 ⟹ Bv≤0 ⟹ (Av2 < Bv2 * Cv) ⟹ (Av < -Bv * sqrt Cv)"
    using real_less_rsqrt real_sqrt_mult by fastforce
  have h5 : "Av≥0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv < 0) =
    (Av < 0 ∧ Bv2 * Cv < Av2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av2 < Bv2 * Cv))"
    using h5a h5b by linarith
  have h6 : "Av≥0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv < 0) =
    (Av < 0 ∧ Bv2 * Cv < Av2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av2 < Bv2 * Cv))"
    by (smt detGreat0 mult_nonneg_nonneg real_sqrt_ge_zero)
  have h7a : "Av<0 ⟹ Bv>0 ⟹ (Av < -Bv * sqrt Cv) ⟹ (Bv2 * Cv < Av2)"
    by (smt mult_minus_left real_sqrt_abs real_sqrt_le_mono real_sqrt_mult)
  have h7b : "Av<0 ⟹ Bv>0 ⟹ (Bv2 * Cv < Av2) ⟹ (Av < -Bv * sqrt Cv)"
    by (metis abs_of_nonneg abs_real_def add.commute less_eq_real_def mult.assoc mult_minus_left power2_eq_square real_add_less_0_iff real_sqrt_less_iff real_sqrt_mult real_sqrt_mult_self)
  have h7 : "Av<0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv < 0) =
    (Av < 0 ∧ Bv2 * Cv < Av2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av2 < Bv2 * Cv))"
    using h7a h7b by linarith
  show ?thesis
    apply(simp add: hA hB h1 h2 insertion_add insertion_mult insertion_var lLength)
    using h3 h4 h5 h6 h7 by smt 
qed

lemma quadratic_sub_less :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Less p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Less p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Less p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"

  have h3b : "MPoly_Type.degree p2 var ≤ 1"
    using freeC quad_part_2_deg p2_def by blast
  then have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1"
    by auto
  have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis 
  have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp
  have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = 
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast 
  have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "∃x::real. ∀y::real. insertion (nth_default 0(list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "∃x::real. ∀y::real. insertion (nth_default 0(list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast

  have h1 : "aEval (Less p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Less (quadratic_part_1 var a b d (Less p))) (list_update L var (sqrt Cv))"
    using quad_part_1_less assms by blast
  also have "... = aEval (Less p1) (list_update L var (sqrt Cv))"
    using p1_def by auto
  also have "... = aEval (Less (quadratic_part_2 var c p1)) (list_update L var (sqrt Cv))"
    using quad_part_2_less assms by blast
  also have "... = aEval (Less p2) (list_update L var (sqrt Cv))"
    using p2_def by auto
  also have "... = aEval (Less (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have "... = eval
     (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B2 * c - A2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A2 - B2 * c))))))
     (list_update L var (sqrt Cv))"
    using quadratic_sub_less_helper hc detGreater0 h4a h4b lLength by blast
  also have  "... = eval (quadratic_sub var a b c d (Less p)) (list_update L var (sqrt Cv))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(2) by metis
  finally show ?thesis by blast
qed

(*------------------------------------------------------------------------------------------------*) 
lemma quadratic_sub_leq_helper :
  assumes lLength : "length L > var"
  assumes detGreat0 : "Cv≥0"
  assumes hC : "∀x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)"
  assumes hA : "∀x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)"
  assumes hB : "∀x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)"
  shows "aEval (Leq (A + B * Var var)) (list_update L var (sqrt Cv)) = 
  eval (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*C-A^2))))(And (Atom(Leq B)) (Atom(Leq (A^2-B^2*C))))) (list_update L var (sqrt Cv))"
proof-
  have h1 : "∀x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h2 : "∀x. insertion (nth_default 0 (list_update L var x)) ((B^2)*C-A^2) = (Bv^2)*Cv-Av^2"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h3 : "Av=0 ⟹ Bv=0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv2 * Cv ≤ Av2 ∨ Bv ≤ 0 ∧ Av2 ≤ Bv2 * Cv)"
    by simp
  have h4 : "Av<0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv2 * Cv ≤ Av2 ∨ Bv ≤ 0 ∧ Av2 ≤ Bv2 * Cv)"
    by (smt detGreat0 real_sqrt_ge_zero zero_less_mult_iff)
  have h5 : "Av=0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv2 * Cv ≤ Av2 ∨ Bv ≤ 0 ∧ Av2 ≤ Bv2 * Cv)"
    by (smt detGreat0 real_sqrt_ge_zero zero_less_mult_iff)
  have h6 : "Av≥0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv2 * Cv ≤ Av2 ∨ Bv ≤ 0 ∧ Av2 ≤ Bv2 * Cv)"
    by (smt detGreat0 mult_nonneg_nonneg mult_pos_pos real_sqrt_gt_0_iff real_sqrt_zero zero_le_power2 zero_less_mult_pos zero_less_power2)
  have h7a : "Av<0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv ≤ 0) ⟹ Bv2 * Cv ≤ Av2"
    by (smt real_sqrt_abs real_sqrt_less_mono real_sqrt_mult)
  have h7b : "Av<0 ⟹ Bv>0 ⟹  Bv2 * Cv ≤ Av2 ⟹ (Av + Bv * sqrt Cv ≤ 0) "
    by (smt real_sqrt_abs real_sqrt_less_mono real_sqrt_mult)
  have h7 : "Av<0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv2 * Cv ≤ Av2 ∨ Bv ≤ 0 ∧ Av2 ≤ Bv2 * Cv)"
    using h7a h7b by linarith
  have h8c : "(-Bv * sqrt Cv)^2 = Bv2 * Cv"
    by (simp add: detGreat0 power_mult_distrib)
  have h8a : "Av>0 ⟹ Bv≤0  ⟹ (Av ≤ -Bv * sqrt Cv) ⟹  Av2 ≤ Bv2 * Cv"
    using detGreat0 h8c power_both_sides by smt 
  have h8b : "Av>0 ⟹ Bv≤0  ⟹   Av2 ≤ Bv2 * Cv ⟹ (Av + Bv * sqrt Cv ≤ 0) "
    using detGreat0 h8c power_both_sides
    by (smt mult_minus_left real_sqrt_ge_zero zero_less_mult_iff) 
  have h8 : "Av>0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv2 * Cv ≤ Av2 ∨ Bv ≤ 0 ∧ Av2 ≤ Bv2 * Cv)"
    using h8a h8b by linarith
  show ?thesis
    apply(simp add: hA hB h1 h2 insertion_add insertion_mult insertion_var lLength)
    using h3 h4 h5 h6 h7 h8 by smt
qed

lemma quadratic_sub_leq :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Leq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Leq p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Leq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"

  have h3b : "MPoly_Type.degree p2 var ≤ 1"
    using freeC quad_part_2_deg p2_def lLength by metis
  then have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1"
    by auto
  have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis 
  have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp
  have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = 
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast 
  have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast

  have "aEval (Leq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Leq p1) (list_update L var (sqrt Cv))"
    using quad_part_1_leq nonzero ha hb hd p1_def lLength by metis
  also have "... = aEval (Leq p2) (list_update L var (sqrt Cv))"
    using p2_def quad_part_2_leq hc detGreater0 lLength by metis
  also have "... = aEval (Leq (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have h4 : "... = eval
     (Or
      (And
        (Atom(Leq(A)))
        (Atom (Leq(B^2*c-A^2))))
      (And
        (Atom(Leq B))
        (Atom(Leq (A^2-B^2*c)))))
     (list_update L var (sqrt Cv))"
    using quadratic_sub_leq_helper hc detGreater0 h4a h4b lLength by blast
  also have "... = eval (quadratic_sub var a b c d (Leq p)) (list_update L var (sqrt Cv))"
    using p1_def quadratic_sub.simps(3) p2_def A_def B_def by metis
  finally show ?thesis by blast
qed
  (*------------------------------------------------------------------------------------------------*)
lemma quadratic_sub_neq :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Neq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Neq p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Neq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"

  have h3b : "MPoly_Type.degree p2 var ≤ 1"
    using freeC quad_part_2_deg p2_def lLength by metis
  then have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1"
    by auto
  have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis 
  have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp
  have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = 
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast 
  have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast
  have h4c : "aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv))
           = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    using quad_equality_helper hc detGreater0 h4a h4b lLength by blast
  have h4d : "aEval (Neq (A + B * Var var)) (list_update L var (sqrt Cv))
           = (¬ (eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))))"
    using aEval.simps(1) aEval.simps(4) h4c by blast
  have h4e : "(¬ (eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))))
                = eval (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    by (metis aNeg.simps(2) aNeg.simps(3) aNeg_aEval eval.simps(1) eval.simps(4) eval.simps(5) mult_minus_left)

  have "aEval (Neq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Neq p1) (list_update L var (sqrt Cv))"
    using quad_part_1_neq nonzero ha hb hd p1_def lLength by blast
  also have "... = aEval (Neq p2) (list_update L var (sqrt Cv))"
    using p2_def quad_part_2_neq hc detGreater0 lLength by metis
  also have "... = aEval (Neq (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have "... = eval (Or
      (Atom(Less(-A*B)))
      (Atom (Neq(A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    using h4c h4d h4e by auto
  also have "... = eval (quadratic_sub var a b c d (Neq p)) (list_update L var (sqrt Cv))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(4) quadratic_part_1.simps(1) quadratic_part_1.simps(4)
    by (metis (no_types, lifting))
  finally show ?thesis by blast
qed
  (*-----------------------------------------------------------------------------------------------*)
theorem free_in_quad :
  assumes freeA : "var∉ vars a"
  assumes freeB : "var∉ vars b"
  assumes freeC : "var∉ vars c"
  assumes freeD : "var∉ vars d"
  shows "freeIn var (quadratic_sub var a b c d A)"
proof(cases A)
  case (Less p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Less p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Less p)) = freeIn var (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B2 * c - A2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A2 - B2 * c))))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(2) by metis
  have h2d : "var∉vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var ((Or (And (fm.Atom (Less A)) (fm.Atom (Less (B2 * c - A2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A2 - B2 * c)))))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Less by blast
next
  case (Eq p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Eq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Eq p)) = freeIn var (And (Atom(Leq (A*B))) (Atom (Eq (A2 - B2 * c))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(1) by metis
  have h2d : "var∉vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var (And (Atom(Leq (A*B))) (Atom (Eq (A2 - B2 * c))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Eq by blast
next
  case (Leq p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Leq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Leq p)) = freeIn var (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*c-A^2))))(And(Atom(Leq B))(Atom(Leq (A^2-B^2*c)))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(3) by metis
  have h2d : "var∉vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*c-A^2))))(And(Atom(Leq B))(Atom(Leq (A^2-B^2*c)))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Leq by blast
next
  case (Neq p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Neq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Neq p)) = freeIn var (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(4) by metis
  have h2d : "var∉vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Neq by blast
qed

theorem quadratic_sub :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval A (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d A) (list_update L var (sqrt Cv))"
proof(cases A)
  case (Less x1)
  then show ?thesis using quadratic_sub_less assms by blast
next
  case (Eq x2)
  then show ?thesis using quadratic_sub_eq assms by blast
next
  case (Leq x3)
  then show ?thesis using quadratic_sub_leq assms by blast
next
  case (Neq x4)
  then show ?thesis using quadratic_sub_neq assms by blast
qed




lemma free_in_quad_fm_helper :
  assumes freeA : "var∉ vars a"
  assumes freeB : "var∉ vars b"
  assumes freeC : "var∉ vars c"
  assumes freeD : "var∉ vars d"
  shows "freeIn (var+z) (quadratic_sub_fm_helper var a b c d F z)"
proof(induction F arbitrary: z)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  then show ?case using free_in_quad[OF not_in_lift[OF assms(1)] not_in_lift[OF assms(2)] not_in_lift[OF assms(3)] not_in_lift[OF assms(4)], of z] by auto
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)
  then show ?case by auto
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  show ?case using ExQ[of "z+1"] by simp
next
  case (AllQ F)
  show ?case using AllQ[of "z+1"] by simp
next
  case (ExN x1 F)
  then show ?case
    by (metis (no_types, lifting) add.assoc freeIn.simps(13) liftmap.simps(10) quadratic_sub_fm_helper.simps)
next
  case (AllN x1 F)
  then show ?case
    by (metis (no_types, lifting) freeIn.simps(12) group_cancel.add1 liftmap.simps(9) quadratic_sub_fm_helper.simps)
qed

theorem free_in_quad_fm :
  assumes freeA : "var∉ vars a"
  assumes freeB : "var∉ vars b"
  assumes freeC : "var∉ vars c"
  assumes freeD : "var∉ vars d"
  shows "freeIn var (quadratic_sub_fm var a b c d A)"
  using free_in_quad_fm_helper[OF assms, of 0] by auto



lemma quadratic_sub_fm_helper :
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes lLength : "length L > var+z"
  assumes ha : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (d::real mpoly) = (Dv :: real)"
  shows "eval F (list_update L (var+z) ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub_fm_helper var a b c d F z) (list_update L (var+z) (sqrt Cv))"
  using assms proof(induction F arbitrary: z L)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  define L1 where "L1 = drop z L"
  define L2 where "L2 = take z L"
  have L_def : "L = L2 @ L1" using L1_def L2_def by auto
  have lengthl2 : "length L2 = z" using L2_def
    using Atom.prems(4) by auto
  have "eval (Atom(Eq (a-Const Av))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (a- Const Av)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (a - Const Av)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(5) unfolding L1_def
    by (metis list_update_id) 
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z a) = Av"
    using lift_minus by blast
  then have a1 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z a) = Av"
    unfolding L_def 
    by (metis (no_types, lifting) Atom.prems(5) L1_def add.right_neutral add_diff_cancel_right' append_eq_append_conv append_eq_append_conv2 length_append lengthl2 lift_insertion list.size(3) list_update_append not_add_less2) 
  have "eval (Atom(Eq (b-Const Bv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (b- Const Bv)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (b - Const Bv)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(6) unfolding L1_def
    by (metis list_update_id) 
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z b) = Bv"
    using lift_minus by blast
  then have a2 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z b) = Bv"
    unfolding L_def using Atom(6) L1_def
    by (metis L_def add_diff_cancel_right' append.simps(1) lengthl2 lift_insertion list.size(3) list_update_append not_add_less2)    
  have "eval (Atom(Eq (c-Const Cv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (c- Const Cv)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (c - Const Cv)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(7) unfolding L1_def
    by (metis list_update_id) 
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = Cv"
    using lift_minus by blast
  then have a3 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z c) = Cv"
    unfolding L_def
  proof -
    obtain nn :: "(nat ⇒ real) ⇒ (nat ⇒ real) ⇒ real mpoly ⇒ nat" where
      "∀x0 x1 x2. (∃v3. v3 ∈ vars x2 ∧ x1 v3 ≠ x0 v3) = (nn x0 x1 x2 ∈ vars x2 ∧ x1 (nn x0 x1 x2) ≠ x0 (nn x0 x1 x2))"
      by moura
    then have f1: "∀m f fa. nn fa f m ∈ vars m ∧ f (nn fa f m) ≠ fa (nn fa f m) ∨ insertion f m = insertion fa m"
      by (meson insertion_irrelevant_vars)
    obtain rr :: real where
      "(∃v0. insertion (nth_default 0 ((L2 @ L1)[var + z := v0])) (liftPoly 0 z c) ≠ Cv) = (insertion (nth_default 0 ((L2 @ L1)[var + z := rr])) (liftPoly 0 z c) ≠ Cv)"
      by blast
    moreover
    { assume "var + z ≠ nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)"
      moreover
      { assume "(nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))) ≠ ((L2 @ L1) ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = (L2 @ L1)[var + z := rr] ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))"
        then have "nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) ≠ (L2 @ L1)[var + z := rr] ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) ∨ nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) ≠ (L2 @ L1) ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)"
          by linarith
        then have "nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) ∉ vars (liftPoly 0 z c) ∨ nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))"
          by (metis (no_types) append_Nil2 length_list_update nth_default_append) }
      ultimately have "nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) ∉ vars (liftPoly 0 z c) ∨ nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))"
        by force }
    ultimately show "∀r. insertion (nth_default 0 ((L2 @ L1)[var + z := r])) (liftPoly 0 z c) = Cv"
      using f1 by (metis (full_types) Atom.prems(3) ‹insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = Cv› not_in_lift)
  qed
  have "eval (Atom(Eq (d-Const Dv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (d- Const Dv)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (d - Const Dv)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(8) unfolding L1_def
    by (metis list_update_id) 
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z d) = Dv"
    using lift_minus by blast
  then have a4 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z d) = Dv"
    unfolding L_def
    by (metis Atom(8) L1_def L_def add_diff_cancel_right' append.simps(1) lengthl2 lift_insertion list.size(3) list_update_append not_add_less2)
  then show ?case  apply(simp)
    using quadratic_sub[OF Atom(4) Atom(1) Atom(2) not_in_lift[OF Atom(3)], of "(liftPoly 0 z a)" Av "(liftPoly 0 z b)" Bv "(liftPoly 0 z d)" x
        , OF a1 a2 a3 a4] .
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)
  then show ?case by auto
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  have lengthG : "var + (z + 1) < length (x#L)" for x using ExQ(5) by auto
  have forall : "∀x. insertion (nth_default 0 ((drop z L)[var := x])) a = Av ⟹ 
      ∀x. insertion (nth_default 0 ((drop (z + 1) (x1 # L))[var := x])) a = Av" for x1 a Av
    by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (ExQ F) (L[var + z := (Av + Bv * sqrt Cv) / Dv]) =
    (∃x. eval F (x # L[var + z := (Av + Bv * sqrt Cv) / Dv]))"
    by(simp)
  also have "... = (∃x. eval
          (liftmap
            (λx. quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d))
            F (z + 1))
          (x # L[var + z := sqrt Cv]))"
    apply(rule ex_cong1)
    unfolding l
    using ExQ(1)[OF ExQ(2) ExQ(3) ExQ(4) lengthG forall[OF ExQ(6)] forall[OF ExQ(7)] forall[OF ExQ(8)] forall[OF ExQ(9)]]
    unfolding quadratic_sub_fm_helper.simps liftmap.simps
    by simp
  also have "... = eval (quadratic_sub_fm_helper var a b c d (ExQ F) z) (L[var + z := sqrt Cv])"
    unfolding quadratic_sub_fm_helper.simps liftmap.simps eval.simps by auto
  finally show ?case by simp
next
  case (AllQ F)
  have lengthG : "var + (z + 1) < length (x#L)" for x using AllQ(5) by auto
  have forall : "∀x. insertion (nth_default 0 ((drop z L)[var := x])) a = Av ⟹ 
      ∀x. insertion (nth_default 0 ((drop (z + 1) (x1 # L))[var := x])) a = Av" for x1 a Av
    by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (AllQ F) (L[var + z := (Av + Bv * sqrt Cv) / Dv]) =
    (∀x. eval F (x # L[var + z := (Av + Bv * sqrt Cv) / Dv]))"
    by(simp)
  also have "... = (∀x. eval
          (liftmap
            (λx. quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d))
            F (z + 1))
          (x # L[var + z := sqrt Cv]))"
    apply(rule all_cong1)
    unfolding l
    using AllQ(1)[OF AllQ(2) AllQ(3) AllQ(4) lengthG forall[OF AllQ(6)] forall[OF AllQ(7)] forall[OF AllQ(8)] forall[OF AllQ(9)]]
    unfolding quadratic_sub_fm_helper.simps liftmap.simps
    by simp
  also have "... = eval (quadratic_sub_fm_helper var a b c d (AllQ F) z) (L[var + z := sqrt Cv])"
    unfolding quadratic_sub_fm_helper.simps liftmap.simps eval.simps by auto
  finally show ?case by simp
next
  case (ExN x1 F)
  have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)) = ((drop z L))"
    by auto
  have map : "⋀ z L. eval (liftmap (λx A. (quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A)) F (z + x1))
      L = eval (liftmap (λx A. (quadratic_sub (var + x1 + x) (liftPoly 0 (x+x1) a) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) (liftPoly 0 (x+x1) d) A)) F z)
      L"
    apply(induction F) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case apply simp apply(rule ex_cong1)
    subgoal for l
      using map[of z] list[of l] ExN(1)[OF ExN(2-4), of "z+x1" "l@L"] ExN(5-9) list_update_append
      apply auto
      by (simp add: list_update_append) +
    done
next
  case (AllN x1 F)
  have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)) = ((drop z L))"
    by auto
  have map : "⋀ z L. eval (liftmap (λx A. (quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A)) F (z + x1))
      L = eval (liftmap (λx A. (quadratic_sub (var + x1 + x) (liftPoly 0 (x+x1) a) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) (liftPoly 0 (x+x1) d) A)) F z)
      L"
    apply(induction F) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case apply simp apply(rule all_cong1)
    subgoal for l
      using map[of z] list[of l] AllN(1)[OF AllN(2-4), of "z+x1" "l@L"] AllN(5-9)
      apply auto
      by (simp add: list_update_append) +
    done
qed

theorem quadratic_sub_fm :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv ≠ 0"
  assumes detGreater0 : "Cv ≥ 0"
  assumes freeC : "var ∉ vars c"
  assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "eval F (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub_fm var a b c d F) (list_update L var (sqrt Cv))"
  unfolding quadratic_sub_fm.simps using quadratic_sub_fm_helper[OF assms(2) assms(3) assms(4), of 0 L a Av b Bv d F] assms(1) assms(5) assms(6) assms(7) assms(8)
  by (simp add: lLength)
end

Theory EliminateVariable

subsection "Lemmas of the elimVar function"

theory EliminateVariable
  imports LinearCase QuadraticCase  "HOL-Library.Quadratic_Discriminant"
begin




lemma elimVar_eq :
  assumes hlength : "length xs = var"
  assumes in_list : "Eq p ∈ set(L)"
  assumes low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
  shows "((∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) =
    ((∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)))∨ (∀x. aEval (Eq p) (xs @ x # Γ)))"
proof-

  { fix x
    define A where "A = (isolate_variable_sparse p var 2)"
    define B where "B = (isolate_variable_sparse p var 1)"
    define C where "C = (isolate_variable_sparse p var 0)"
    have freeA : "var ∉ vars A"
      unfolding A_def
      by (simp add: not_in_isovarspar)
    have freeB : "var ∉ vars B"
      unfolding B_def
      by (simp add: not_in_isovarspar)
    have freeC : "var ∉ vars C"
      unfolding C_def
      by (simp add: not_in_isovarspar)
    assume "eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)"
    then have h : "(∀a∈set L. aEval a (xs @ x # Γ)) ∧ (∀f∈set F. eval f (xs @ x # Γ))"
      apply(simp add:eval_list_conj)
      by (meson Un_iff eval.simps(1) image_eqI)
    define X where "X=xs@x#Γ"
    have Xlength : "length X > var"
      using X_def hlength by auto
    define Aval where "Aval = insertion (nth_default 0 (list_update X var x)) A"
    define Bval where "Bval = insertion (nth_default 0 (list_update X var x)) B"
    define Cval where "Cval = insertion (nth_default 0 (list_update X var x)) C"
    have hinsert : "(xs @ x # Γ)[var := x] = (xs @ x #Γ)"
      using hlength by auto
    have allAval : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = Aval"
      using Aval_def
      using not_contains_insertion[where var="var", where p = "A", OF freeA, where L = "xs @ x #Γ", where x="x", where val="Aval"]
      unfolding X_def hinsert using hlength by auto
    have allBval : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = Bval"
      using Bval_def
      using not_contains_insertion[where var="var", where p = "B", OF freeB, where L = "xs @ x #Γ", where x="x", where val="Bval"]
      unfolding X_def hinsert using hlength by auto
    have allCval : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = Cval"
      using Cval_def
      using not_contains_insertion[where var="var", where p = "C", OF freeC, where L = "xs @ x #Γ", where x="x", where val="Cval"]
      unfolding X_def hinsert using hlength by auto
    have insertion_p : "insertion (nth_default 0 X) p = 0"
      using in_list h aEval.simps(1) X_def by fastforce
    have express_p : "p = A * Var var ^ 2 + B * Var var + C"
      using express_poly[OF low_pow] unfolding A_def B_def C_def
      by fastforce
    have insertion_p' : "Aval *x^2+Bval *x+Cval = 0"
      using express_p insertion_p unfolding Aval_def Bval_def Cval_def X_def hinsert
      apply(simp add: insertion_add insertion_mult insertion_pow)
      using  insertion_var by (metis X_def Xlength hinsert) 
    have biglemma : "
       ((Aval = 0 ∧
        Bval ≠ 0 ∧
        (∀f∈set L. aEval (linear_substitution var (-C) B f) (xs @ x # Γ)) ∧ 
        (∀f∈set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # Γ)) ∨
        Aval ≠ 0 ∧
        insertion (nth_default 0 (xs @ x # Γ)) 4 * 
        Aval *
        Cval
        ≤ (Bval)2 ∧
        ((∀f∈set L. eval (quadratic_sub var (- B) 1 (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))∧
         (∀f∈set F. eval (quadratic_sub_fm var (- B) 1 (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∨
         (∀f∈set L. eval (quadratic_sub var (- B) (-1) (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∧
         (∀f∈set F. eval (quadratic_sub_fm var (- B) (-1) (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))) ∨
        Aval = 0 ∧
        Bval = 0 ∧
        Cval = 0))"
    proof(cases "Aval=0")
      case True
      then have aval0 : "Aval=0" by simp
      show ?thesis proof(cases "Bval=0")
        case True
        then have bval0 :  "Bval=0" by simp
        have h : "eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)"
          using hlength h unfolding X_def
          using ‹eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)› by blast
        show ?thesis proof(cases "Cval=0")
          case True
          show ?thesis                                  
            by(simp add:aval0 True bval0)
        next
          case False
          show ?thesis
            using insertion_p' aval0 bval0 False by(simp)
        qed
      next
        case False
        have bh : "insertion (nth_default 0 (X[var := - Cval / Bval])) B = Bval"
          using allBval unfolding X_def
          using Bval_def X_def freeB not_contains_insertion by blast
        have ch : "insertion (nth_default 0 (X[var := - Cval / Bval])) C = Cval"
          using allCval unfolding X_def
          using Cval_def X_def freeC not_contains_insertion by blast
        have xh : "x=-Cval/Bval"
        proof-
          have "Bval*x+Cval = 0"
            using insertion_p' aval0
            by simp
          then show ?thesis using False
            by (smt nonzero_mult_div_cancel_left)
        qed
        have freecneg : "var ∉ vars (-C)" using freeC not_in_neg by auto
        have h1:  "(∀a∈set L. aEval (linear_substitution var (-C) (B) a) (X[var := x]))"
          using h xh Bval_def Cval_def False LinearCase.linear[OF Xlength False freecneg freeB, of "-Cval"] freeB freeC freecneg
          by (metis X_def hinsert insertion_neg)
        have h2 : "∀f∈set F. eval (linear_substitution_fm var (-C) B f) (X[var := x])"
          using h xh Bval_def Cval_def False LinearCase.linear_fm[OF Xlength False freecneg freeB, of "-Cval"] freeB freeC
          by (metis X_def hinsert insertion_neg)
        show ?thesis using h1 h2 apply(simp add:aval0 False)
          using X_def hlength
          using hinsert by auto
      qed
    next
      case False
      then have aval0 : "Aval ≠0" by simp
      have h4 : "insertion (nth_default 0 (X[var := x])) 4 = 4"
        using insertion_const[where f = "(nth_default 0 (X[var := x]))", where c="4"]
        by (metis MPoly_Type.insertion_one insertion_add numeral_Bit0 one_add_one)
      show ?thesis proof(cases "4 * Aval * Cval ≤ Bval2")
        case True
        have h1a : "var∉vars(-B)"
          by(simp add: freeB not_in_neg)
        have h1b : "var∉vars(1::real mpoly)"
          using isolate_var_one not_in_isovarspar by blast
        have h1c : "var∉vars(-1::real mpoly)"
          by(simp add: h1b not_in_neg)
        have h1d : "var∉vars(4::real mpoly)"
          by (metis h1b not_in_add numeral_Bit0 one_add_one)
        have h1e : "var∉vars(B^2-4*A*C)" 
          by(simp add: freeB h1d freeA freeC not_in_mult not_in_pow not_in_sub)
        have h1f : "var∉vars(2::real mpoly)"
          using h1b not_in_add by fastforce
        have h1g : "var∉vars(2*A)"
          by(simp add: freeA h1f not_in_mult)
        have h1h : "freeIn var (quadratic_sub var (-B) (1) (B^2-4*A*C) (2*A) a)"
          using free_in_quad h1a h1b h1e h1g by blast
        have h1i : "freeIn var (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a)"
          using free_in_quad h1a h1c h1e h1g by blast 
        have h2 : "2*Aval ≠ 0" using aval0 by auto
        have h3 : "0 ≤ (Bval^2-4*Aval*Cval)" using True by auto
        have h4a : "var ∉ vars 4"
          by (metis monom_numeral notInKeys_notInVars not_in_add not_in_isovarspar not_in_pow one_add_one power.simps(1) rel_simps(76) vars_monom_keys) 
        have h4 : "var ∉ vars (B^2-4*A*C)" by(simp add: h4a freeA freeB freeC not_in_pow not_in_mult not_in_sub)  
        have h5 : "∀x. insertion (nth_default 0 (list_update X var x)) (-B) = -Bval " 
          using allBval apply(simp add: insertion_neg)
          by (simp add: B_def Bval_def insertion_isovarspars_free)
        have h6 : "∀x. insertion (nth_default 0 (list_update X var x)) 1 = 1" by simp
        have h6a : "∀x. insertion (nth_default 0 (list_update X var x)) (-1) = (-1)" using h6 by (simp add: insertion_neg) 
        have h7a : "∀x. insertion (nth_default 0 (list_update X var x)) 4 = 4" by (metis h6 insertion_add numeral_Bit0 one_add_one)
        have h7b : "var ∉ vars(4*A*C)" using freeA freeC by (simp add: h4a not_in_mult) 
        have h7c : "var ∉ vars(B^2)" using freeB not_in_pow by auto
        have h7 : "∀x. insertion (nth_default 0 (list_update X var x)) (B^2-4*A*C) = (Bval^2-4*Aval*Cval)"
          using h7a allAval allBval allCval unfolding X_def  using hlength 
          apply (simp add: insertion_mult insertion_sub power2_eq_square)
          by (metis A_def Aval_def Bval_def C_def Cval_def X_def freeB insertion_isovarspars_free not_contains_insertion)
        have h8a : "∀x. insertion (nth_default 0 (list_update X var x)) 2 = 2" by (metis h6 insertion_add one_add_one)
        have h8 : "∀x. insertion (nth_default 0 (list_update X var x)) (2*A) = (2*Aval)"
          apply(simp add: allAval h8a insertion_mult)
          by (simp add: A_def Aval_def insertion_isovarspars_free)

        have h1 : "- Bval2 + 4 * Aval * Cval ≤ 0"
          using True by simp
        have xh : "x = (- Bval + sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)∨x=(- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)"
          using insertion_p' aval0 h1
            discriminant_iff unfolding discrim_def by blast
        have p1 : "x = (- Bval + sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval) ⟹ 
                                                            ((∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                                                      ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))"
        proof-
          assume x_def : "x = (- Bval + sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)"
          then have h : "(∀a∈set L. aEval a (X[var := (- Bval + sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)])) ∧ (∀f∈set F. eval f (X[var := (- Bval + sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)]))"
            using h
            using X_def hinsert by auto
          { fix a
            assume in_list : "a∈ set L"
            have "eval (quadratic_sub var (- B) 1 (B2 - 4 * A * C) (2 * A) a) (X[var := x])"
              using free_in_quad[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
              using quadratic_sub[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                  where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
                  h in_list
              using var_not_in_eval by fastforce 

          }
          then have left : "(∀a∈set L. eval (quadratic_sub var (- B) 1 (B2 - 4 * A * C) (2 * A) a) (X[var := x]))"
            by simp


          { fix a
            assume in_list : "a∈ set F"
            have "eval (quadratic_sub_fm var (- B) 1 (B2 - 4 * A * C) (2 * A) a) (X[var := x])"
              using free_in_quad_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
              using quadratic_sub_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                  where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
                  h in_list
              using var_not_in_eval by fastforce 

          }
          then have right : "(∀a∈set F. eval (quadratic_sub_fm var (- B) 1 (B2 - 4 * A * C) (2 * A) a) (X[var := x]))"
            by simp
          show ?thesis
            using right left by simp
        qed

        have p2 : "x = (- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval) ⟹ 
                                                            ((∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                                                      ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])))"
        proof -
          assume x_def : "x = (- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)"
          then have h : "(∀a∈set L. aEval a (X[var := (- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)])) ∧ (∀f∈set F. eval f (X[var := (- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)]))"
            using h
            using X_def hinsert by auto
          then have "(∀a∈set L. aEval a (X[var := (- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)])) ∧ (∀f∈set F. eval f (X[var := (- Bval - sqrt (Bval2 - 4 * Aval * Cval)) / (2 * Aval)]))"
            using h  by simp
          { fix a
            assume in_list : "a∈ set L"
            have "eval (quadratic_sub var (- B) (-1) (B2 - 4 * A * C) (2 * A) a) (X[var := x])"
              using free_in_quad[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
              using quadratic_sub[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                  where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]
                  h in_list
              using var_not_in_eval by fastforce 

          }
          then have left : "(∀a∈set L. eval (quadratic_sub var (- B) (-1) (B2 - 4 * A * C) (2 * A) a) (X[var := x]))"
            by simp


          { fix a
            assume in_list : "a∈ set F"
            have "eval (quadratic_sub_fm var (- B) (-1) (B2 - 4 * A * C) (2 * A) a) (X[var := x])"
              using free_in_quad_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
              using quadratic_sub_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                  where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]
                  h in_list
              using var_not_in_eval by fastforce 

          }
          then have right : "(∀a∈set F. eval (quadratic_sub_fm var (- B) (-1) (B2 - 4 * A * C) (2 * A) a) (X[var := x]))"
            by simp
          show ?thesis
            using right left by simp
        qed
        have subst4 : "insertion (nth_default 0 (xs @ x # Γ)) 4 = 4" using h7a hlength X_def by auto 
        have disj: "(∀a∈set L. eval (quadratic_sub var (- B) 1 (B2 - 4 * A * C) (2 * A) a) (xs @ x # Γ)) ∧
                                                            (∀a∈set F. eval (quadratic_sub_fm var (- B) 1 (B2 - 4 * A * C) (2 * A) a) (xs @ x # Γ)) ∨ 
                                                            (∀a∈set L. eval (quadratic_sub var (- B) (-1) (B2 - 4 * A * C) (2 * A) a) (xs @ x # Γ)) ∧
                                                            (∀a∈set F. eval (quadratic_sub_fm var (- B) (-1) (B2 - 4 * A * C) (2 * A) a) (xs @ x # Γ))"
          using xh p1 p2
          unfolding X_def hinsert  by blast
        show ?thesis apply(simp add: aval0 True h7a subst4) using disj
          unfolding X_def hinsert by auto
      next
        case False
        then have det : "0 < - Bval2 + 4 * Aval * Cval"
          by simp
        show ?thesis apply(simp add: aval0 False h4) using discriminant_negative unfolding discrim_def
          using insertion_p'
          using aval0 det by auto 
      qed
    qed
    have "(∃x.
       (insertion (nth_default 0 (xs @ x # Γ)) A = 0 ∧
        insertion (nth_default 0 (xs @ x # Γ)) B ≠ 0 ∧
        (∀f∈set L. aEval (linear_substitution var (-C) (B) f) (xs @ x # Γ)) ∧ 
        (∀f∈set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # Γ)) ∨
        insertion (nth_default 0 (xs @ x # Γ)) A ≠ 0 ∧
        insertion (nth_default 0 (xs @ x # Γ)) 4 * 
        insertion (nth_default 0 (xs @ x # Γ)) A *
        insertion (nth_default 0 (xs @ x # Γ)) C
        ≤ (insertion (nth_default 0 (xs @ x # Γ)) B)2 ∧
        ((∀f∈set L. eval (quadratic_sub var (- B) 1 (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))∧
         (∀f∈set F. eval (quadratic_sub_fm var (- B) 1 (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∨
         (∀f∈set L. eval (quadratic_sub var (- B) (-1) (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∧
         (∀f∈set F. eval (quadratic_sub_fm var (- B) (-1) (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)))) ∨
        (Aval = 0 ∧
        Bval = 0 ∧
        Cval = 0))"
      apply(rule exI[where x=x])
      using biglemma
      using allAval allBval allCval unfolding A_def B_def C_def Aval_def Bval_def Cval_def X_def hinsert
      by auto
    then obtain x where x : "(insertion (nth_default 0 (xs @ x # Γ)) A = 0 ∧
        insertion (nth_default 0 (xs @ x # Γ)) B ≠ 0 ∧
        (∀f∈set L. aEval (linear_substitution var (-C) (B) f) (xs @ x # Γ)) ∧ 
        (∀f∈set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # Γ)) ∨
        insertion (nth_default 0 (xs @ x # Γ)) A ≠ 0 ∧
        insertion (nth_default 0 (xs @ x # Γ)) 4 * 
        insertion (nth_default 0 (xs @ x # Γ)) A *
        insertion (nth_default 0 (xs @ x # Γ)) C
        ≤ (insertion (nth_default 0 (xs @ x # Γ)) B)2 ∧
        ((∀f∈set L. eval (quadratic_sub var (- B) 1 (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))∧
         (∀f∈set F. eval (quadratic_sub_fm var (- B) 1 (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∨
         (∀f∈set L. eval (quadratic_sub var (- B) (-1) (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∧
         (∀f∈set F. eval (quadratic_sub_fm var (- B) (-1) (B2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)))) ∨
        (Aval = 0 ∧
        Bval = 0 ∧
        Cval = 0)" by auto
    have h : "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))∨(Aval = 0 ∧ Bval = 0 ∧ Cval = 0)"
    proof(cases "(Aval = 0 ∧ Bval = 0 ∧ Cval = 0)")
      case True
      then show ?thesis by simp
    next
      case False
      have "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))"
        apply(rule exI[where x=x])
        apply(simp add: eval_list_conj insertion_mult insertion_sub insertion_pow insertion_add 
            del:  quadratic_sub.simps linear_substitution.simps quadratic_sub_fm.simps linear_substitution_fm.simps)
        unfolding A_def[symmetric] B_def[symmetric] C_def[symmetric] One_nat_def[symmetric] X_def[symmetric]
        using hlength x
        by (auto simp add:False)
      then show ?thesis by auto
    qed
    have "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))∨(∀x. aEval (Eq p) (xs@ x# Γ))"
    proof(cases "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))")
      case True
      then show ?thesis by auto
    next
      case False
      then have "(Aval = 0 ∧ Bval = 0 ∧ Cval = 0)"
        using h by auto
      then have "(∀x. aEval (Eq p) (xs @ x # Γ))"
        unfolding express_p
        apply(simp add:insertion_add insertion_mult insertion_pow)
        using allAval allBval allCval by auto 
      then show ?thesis by auto
    qed
  }
  then have left : "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) ⟹
                        ((∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))∨(∀x. aEval (Eq p) (xs@ x# Γ)))"
    by blast


  {
    assume hlength : "length (xs::real list) = var"
    define A where "A = (isolate_variable_sparse p var 2)"
    define B where "B = (isolate_variable_sparse p var 1)"
    define C where "C = (isolate_variable_sparse p var 0)"
    have freeA : "var ∉ vars A"
      unfolding A_def
      by (simp add: not_in_isovarspar)
    have freeB : "var ∉ vars B"
      unfolding B_def
      by (simp add: not_in_isovarspar)
    have freeC : "var ∉ vars C"
      unfolding C_def
      by (simp add: not_in_isovarspar)
    have express_p : "p = A*(Var var)^2+B*(Var var)+C"
      using express_poly[OF low_pow] unfolding A_def B_def C_def
      by fastforce
    assume h : "(∃x. (eval (elimVar var L F (Eq p)) (list_update (xs@x#Γ) var x)))"
    fix x
    define X where "X=xs@x#Γ"
    have Xlength : "length X > var"
      using X_def hlength by auto
    define Aval where "Aval = insertion (nth_default 0 (list_update X var x)) A"
    define Bval where "Bval = insertion (nth_default 0 (list_update X var x)) B"
    define Cval where "Cval = insertion (nth_default 0 (list_update X var x)) C"
    have allAval : "∀x. insertion (nth_default 0 (list_update X var x)) A = Aval"
      using freeA Aval_def
      using not_contains_insertion by blast
    have allBval : "∀x. insertion (nth_default 0 (list_update X var x)) B = Bval"
      using freeB Bval_def
      using not_contains_insertion by blast
    have allCval : "∀x. insertion (nth_default 0 (list_update X var x)) C = Cval"
      using freeC Cval_def
      using not_contains_insertion by blast
    assume "(eval (elimVar var L F (Eq p)) (list_update (xs@x#Γ) var x))"
    then have h : "(eval (elimVar var L F (Eq p)) (list_update X var x))"
      unfolding X_def .

    have "(Aval = 0 ∧ Bval ≠ 0 ∧
          (∀f∈(λa. Atom(linear_substitution var (-C) B a)) ` set L ∪
             linear_substitution_fm var (-C) B `
             set F.
            eval f (X[var := x])) ∨
          Aval ≠ 0 ∧
          insertion (nth_default 0 (X[var := x])) 4 * Aval * Cval  ≤ Bval2 ∧
          ((∀f∈(quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A)) `
             set L ∪
             (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A)) `
             set F.
            eval f (X[var := x]))
          ∨(∀f∈(quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A)) `
             set L ∪
             (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A)) `
             set F.
            eval f (X[var := x]))
          ))"
      unfolding Aval_def Bval_def Cval_def A_def B_def C_def
      using h by(simp add: eval_list_conj insertion_mult insertion_sub insertion_pow insertion_add insertion_var Xlength)
    then have h : "(Aval = 0 ∧ Bval ≠ 0 ∧
                            ((∀a∈ set L. aEval (linear_substitution var (-C) B a) (X[var := x])) ∧
                            (∀a∈ set F. eval (linear_substitution_fm var (-C) B a) (X[var := x]))) ∨
                            Aval ≠ 0 ∧ insertion (nth_default 0 (X[var := x])) 4 * Aval * Cval ≤ Bval2 ∧
                            (((∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                            ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))
                            ∨((∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                            ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])))))
                          "
      apply(cases "Aval = 0 ")
      apply auto
      by (meson Un_iff eval.simps(1) imageI)
    have h : "(∃x. ((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x]))))∨(Aval=0∧Bval=0∧Cval=0)"
    proof(cases "Aval=0")
      case True
      then have aval0 : "Aval=0"
        by simp
      show ?thesis proof(cases "Bval = 0")
        case True
        then have bval0 : "Bval = 0" by simp
        show ?thesis proof(cases "Cval=0")
          case True
          then show ?thesis using aval0 bval0 True by auto
        next
          case False
          then show ?thesis using h by(simp add:aval0 bval0 False)
        qed 
      next
        case False
        have hb :  "insertion (nth_default 0 (X[var := - Cval / Bval])) B = Bval"
          using allBval by simp
        have hc : "insertion (nth_default 0 (X[var := - Cval / Bval])) (-C) = -Cval"
          using allCval
          by (simp add: insertion_neg) 
        have freecneg : "var∉vars(-C)" using freeC not_in_neg by auto
        have p1 : "(∀a∈set L. aEval a ((xs @ x # Γ)[var := - Cval / Bval]))"
          using h apply(simp add: False aval0)
          using linear[OF Xlength False freecneg freeB hc hb]
            list_update_length var_not_in_linear[OF freecneg freeB]
          unfolding X_def using hlength
          by (metis divide_minus_left)

        have p2 : "(∀a∈set F. eval a ((xs @ x # Γ)[var := - Cval / Bval]))"
          using h apply(simp add: False aval0)
          using linear_fm[OF Xlength False freecneg freeB hc hb]
            list_update_length var_not_in_linear_fm[OF freecneg freeB]
          unfolding X_def using hlength var_not_in_eval
          by (metis divide_minus_left linear_substitution_fm.elims linear_substitution_fm_helper.elims)
        show ?thesis 
          using p1 p2 hlength by fastforce
      qed
    next
      case False
      then have aval0 : "Aval ≠ 0"
        by simp
      have h4 : "insertion (nth_default 0 (X[var := x])) 4 = 4"
        using insertion_const[where f = "(nth_default 0 (X[var := x]))", where c="4"]
        by (metis MPoly_Type.insertion_one insertion_add numeral_Bit0 one_add_one)
      show ?thesis proof(cases "4 * Aval * Cval ≤ Bval2")
        case True
        then have h1 :  "- Bval2 + 4 * Aval * Cval ≤ 0"
          by simp
        have h : "(((∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                        ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))
                        ∨((∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                        ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))))"
          using h by(simp add: h1 aval0)
        have h1a : "var∉vars(-B)"
          by(simp add: freeB not_in_neg)
        have h1b : "var∉vars(1::real mpoly)"
          using isolate_var_one not_in_isovarspar by blast
        have h1c : "var∉vars(-1::real mpoly)"
          by(simp add: h1b not_in_neg)
        have h1d : "var∉vars(4::real mpoly)"
          by (metis h1b not_in_add numeral_Bit0 one_add_one)
        have h1e : "var∉vars(B^2-4*A*C)" 
          by(simp add: freeB h1d freeA freeC not_in_mult not_in_pow not_in_sub)
        have h1f : "var∉vars(2::real mpoly)"
          using h1b not_in_add by fastforce
        have h1g : "var∉vars(2*A)"
          by(simp add: freeA h1f not_in_mult)
        have h1h : "freeIn var (quadratic_sub var (-B) (1) (B^2-4*A*C) (2*A) a)"
          using free_in_quad h1a h1b h1e h1g by blast
        have h1i : "freeIn var (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a)"
          using free_in_quad h1a h1c h1e h1g by blast 
        have h2 : "2*Aval ≠ 0" using aval0 by auto
        have h3 : "0 ≤ (Bval^2-4*Aval*Cval)" using True by auto
        have h4a : "var ∉ vars 4"
          by (metis monom_numeral notInKeys_notInVars not_in_add not_in_isovarspar not_in_pow one_add_one power.simps(1) rel_simps(76) vars_monom_keys) 
        have h4 : "var ∉ vars (B^2-4*A*C)" by(simp add: h4a freeA freeB freeC not_in_pow not_in_mult not_in_sub)  
        have h5 : "∀x. insertion (nth_default 0 (list_update X var x)) (-B) = -Bval " using allBval by(simp add: insertion_neg)
        have h6 : "∀x. insertion (nth_default 0 (list_update X var x)) 1 = 1" by simp
        have h6a : "∀x. insertion (nth_default 0 (list_update X var x)) (-1) = (-1)" using h6 by (simp add: insertion_neg) 
        have h7a : "∀x. insertion (nth_default 0 (list_update X var x)) 4 = 4" by (metis h6 insertion_add numeral_Bit0 one_add_one)
        have h7b : "var ∉ vars(4*A*C)" using freeA freeC by (simp add: h4a not_in_mult) 
        have h7c : "var ∉ vars(B^2)" using freeB not_in_pow by auto
        have h7 : "∀x. insertion (nth_default 0 (list_update X var x)) (B^2-4*A*C) = (Bval^2-4*Aval*Cval)"
          by (simp add: h7a allAval allBval allCval insertion_mult insertion_sub power2_eq_square)
        have h8a : "∀x. insertion (nth_default 0 (list_update X var x)) 2 = 2" by (metis h6 insertion_add one_add_one)
        have h8 : "∀x. insertion (nth_default 0 (list_update X var x)) (2*A) = (2*Aval)" by(simp add: allAval h8a insertion_mult)

        have p1 : "(∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                        ⟹(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))
                          ⟹ ∃x. length xs = var ∧ ((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x])))"
        proof-
          assume p1 : "(∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))"
          assume p2 : "(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))"
          show ?thesis
            using free_in_quad[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
            using quadratic_sub[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
            using free_in_quad_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g]
            using quadratic_sub_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
                where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8]
                p1 p2
            using var_not_in_eval
            by (metis X_def hlength list_update_length)
        qed
        have p2 : "(∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                        ⟹(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))
                          ⟹∃x. length xs = var ∧ ((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x])))"
          using free_in_quad[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
          using quadratic_sub[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
              where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]

          using free_in_quad_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g]
          using quadratic_sub_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength,
              where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8]

          using var_not_in_eval by (metis X_def hlength list_update_length)
        then show ?thesis
          using h p1 p2 by blast
      next
        case False
        then show ?thesis using h by(simp add: aval0 False h4)
      qed
    qed
    have "(∃x.((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x]))))∨(∀x. aEval (Eq p) (xs @ x#Γ))"
    proof(cases "(∃x.((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x]))))")
      case True
      then show ?thesis by auto
    next
      case False
      then have "Aval=0∧Bval=0∧Cval=0" using h by auto
      then have "(∀x. aEval (Eq p) (xs @ x # Γ))"
        unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow)
        using allAval allBval allCval hlength unfolding X_def by auto
      then show ?thesis by auto
    qed
  }


  then have right : "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)) ⟹
               ((∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ))∨(∀x. aEval (Eq p) (xs @ x # Γ)))"
    by (smt UnE eval.simps(1) eval_list_conj hlength imageE list_update_length set_append set_map)


  show ?thesis using right left by blast
qed

text "simply states that the variable is free in the equality case of the elimVar function"
lemma freeIn_elimVar_eq : "freeIn var (elimVar var L F (Eq p))"
proof-
  have h4 : "var ∉ vars(4:: real mpoly)" using var_not_in_Const
    by (metis (full_types) isolate_var_one monom_numeral not_in_isovarspar numeral_One vars_monom_keys zero_neq_numeral)
  have hlinear: "∀f∈set(map (λa. Atom(linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) a)) L @
        map (linear_substitution_fm var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)))
         F). freeIn var f" 
    using
      var_not_in_linear[where c="(isolate_variable_sparse p var (Suc 0))", where b="(- isolate_variable_sparse p var 0)", where var="var"]
      var_not_in_linear_fm[where c="(isolate_variable_sparse p var (Suc 0))", where b="(-isolate_variable_sparse p var 0)", where var="var"]
      not_in_isovarspar not_in_neg by auto
  have freeA : "var ∉ vars (- isolate_variable_sparse p var (Suc 0))"
    using not_in_isovarspar not_in_neg by auto
  have freeB1 : "var ∉ vars (1::real mpoly)"
    by (metis h4 monom_numeral monom_one notInKeys_notInVars vars_monom_keys zero_neq_numeral)
  have freeC : "var ∉ vars (((isolate_variable_sparse p var (Suc 0))2 -
                    4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0))"
    using not_in_isovarspar not_in_pow not_in_sub not_in_mult h4 by auto
  have freeD : "var ∉ vars ((2 * isolate_variable_sparse p var 2))"
    using not_in_isovarspar not_in_mult
    by (metis mult_2 not_in_add) 
  have freeB2 : "var∉vars (-1::real mpoly)"
    using freeB1 not_in_neg by auto
  have quadratic1 : "∀f∈set(map (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1
              ((isolate_variable_sparse p var (Suc 0))2 -
               4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
              (2 * isolate_variable_sparse p var 2))
         L @
        map (quadratic_sub_fm var (- isolate_variable_sparse p var (Suc 0)) 1
              ((isolate_variable_sparse p var (Suc 0))2 -
               4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
              (2 * isolate_variable_sparse p var 2))
         F). freeIn var f" 
    using free_in_quad[OF freeA freeB1 freeC freeD]
      free_in_quad_fm[OF freeA freeB1 freeC freeD] by auto
  have quadratic2 : "∀f∈set(map (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1)
              ((isolate_variable_sparse p var (Suc 0))2 -
               4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
              (2 * isolate_variable_sparse p var 2))
         L @
        map (quadratic_sub_fm var (- isolate_variable_sparse p var (Suc 0)) (-1)
              ((isolate_variable_sparse p var (Suc 0))2 -
               4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
              (2 * isolate_variable_sparse p var 2))
         F). freeIn var f"
    using free_in_quad[OF freeA freeB2 freeC freeD]
      free_in_quad_fm[OF freeA freeB2 freeC freeD] by auto
  show ?thesis
    using not_in_mult not_in_add h4 not_in_pow not_in_sub freeIn_list_conj not_in_isovarspar hlinear quadratic1 quadratic2
    by(simp add: )
qed


text "Theorem 20.2 in the textbook"
lemma elimVar_eq_2 :
  assumes hlength : "length xs = var"
  assumes in_list : "Eq p ∈ set(L)"
  assumes low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
  assumes nonzero : "∀x. 
              insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0
            ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0
            ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0" (is ?non0)
  shows "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) =
         (∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))"
proof-
  define A where "A = (isolate_variable_sparse p var 2)"
  define B where "B = (isolate_variable_sparse p var 1)"
  define C where "C = (isolate_variable_sparse p var 0)"
  have freeA : "var ∉ vars A"
    unfolding A_def
    by (simp add: not_in_isovarspar)
  have freeB : "var ∉ vars B"
    unfolding B_def
    by (simp add: not_in_isovarspar)
  have freeC : "var ∉ vars C"
    unfolding C_def
    by (simp add: not_in_isovarspar)
  have express_p : "p = A*(Var var)^2+B*(Var var)+C"
    using express_poly[OF low_pow] unfolding A_def B_def C_def
    by fastforce
  have af : "isolate_variable_sparse p var 2 = A"
    using A_def by auto
  have bf : "isolate_variable_sparse p var (Suc 0) = B"
    using B_def by auto
  have cf : "isolate_variable_sparse p var 0 = C"
    using C_def by auto
  have xlength : "∀x. (insertion (nth_default 0 (xs @ x # Γ)) (Var var))= x" 
    using hlength insertion_var
    by (metis add.commute add_strict_increasing length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl)
  fix x
  define c where "c i = (insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var i))" for i
  have c2 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = c 2" 
    using freeA apply(simp add: A_def c_def)
    by (simp add: hlength insertion_lowerPoly1)
  have c1 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = c 1"
    using freeB apply(simp add: B_def c_def)
    by (simp add: hlength insertion_lowerPoly1)
  have c0 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = c 0"
    using freeC apply(simp add: C_def c_def)
    by (simp add: hlength insertion_lowerPoly1)
  have sum : "∀x. c 2 * x2 + c (Suc 0) * x + c 0 = (∑i≤2. c i * x ^ i)"
    by (simp add: numerals(2))
  have "(∀x. aEval (Eq p) (xs @ x # Γ)) = (¬?non0)"
    apply(simp add : af bf cf)
    unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow xlength)
    apply(simp add:c2 c1 c0)
    apply(simp add: sum)
    using polyfun_eq_0[where c="c", where n="2"]
    using sum by auto
  then have "¬(∀x. aEval (Eq p) (xs @ x Γ))"
    using nonzero by auto
  then show ?thesis
    using disjE[OF elimVar_eq[OF hlength in_list, where F="F", where Γ="Γ"], where R="?thesis"]
    using ‹(∀x. aEval (Eq p) (xs @ x # Γ)) = (¬ (∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0))› low_pow nonzero by blast
qed



end

Theory LuckyFind

subsection "Overall LuckyFind Proofs"
theory LuckyFind
  imports EliminateVariable
begin



theorem luckyFind_eval:
  assumes "luckyFind x L F = Some F'"
  assumes "length xs = x"
  shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval F' (xs @ (x#Γ))))"
proof(cases "find_lucky_eq x L")
  case None
  then show ?thesis using assms by auto
next
  case (Some p)
  have inset : "Eq p ∈ set L"
    using Some proof(induction L)
    case Nil
    then show ?case by auto
  next
    case (Cons a L)
    then show ?case proof(cases a)
      case (Less x1)
      then show ?thesis using Cons by auto
    next
      case (Eq p')
      show ?thesis using Cons
        unfolding Eq apply simp apply(cases "(MPoly_Type.degree p' x = Suc 0 ∨ MPoly_Type.degree p' x = 2)") apply simp_all
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 2)") apply(simp_all)
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 1)") apply(simp_all)
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 0)") by(simp_all)
    next
      case (Leq x3)
      then show ?thesis using Cons by auto
    next
      case (Neq x4)
      then show ?thesis using Cons by auto
    qed
  qed
  have degree : "MPoly_Type.degree p x = 1 ∨ MPoly_Type.degree p x = 2"
    using Some proof(induction L)
    case Nil
    then show ?case by auto
  next
    case (Cons a L)
    then show ?case proof(cases a)
      case (Less x1)
      then show ?thesis using Cons by auto
    next
      case (Eq p')
      show ?thesis using Cons
        unfolding Eq apply simp apply(cases "(MPoly_Type.degree p' x = Suc 0 ∨ MPoly_Type.degree p' x = 2)") apply simp_all
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 2)") apply(simp_all)
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 1)") apply(simp_all)
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 0)") by(simp_all)
    next
      case (Leq x3)
      then show ?thesis using Cons by auto
    next
      case (Neq x4)
      then show ?thesis using Cons by auto
    qed
  qed
  have nonzero : "∀xa. insertion (nth_default 0 (xs @ xa # Γ)) (isolate_variable_sparse p x 2) ≠ 0 ∨
       insertion (nth_default 0 (xs @ xa # Γ)) (isolate_variable_sparse p x 1) ≠ 0 ∨
       insertion (nth_default 0 (xs @ xa # Γ)) (isolate_variable_sparse p x 0) ≠ 0"
    using Some proof(induction L)
    case Nil
    then show ?case by auto
  next
    case (Cons a L)
    then show ?case proof(cases a)
      case (Less x1)
      then show ?thesis using Cons by auto
    next
      case (Eq p')
      have h : "⋀p xa. check_nonzero_const p ⟹ insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0"
      proof-
        fix p xa
        assume h : "check_nonzero_const p"
        show "insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0"
          apply(cases "get_if_const p")
          using h get_if_const_insertion by simp_all
      qed
      show ?thesis using Cons(2)
        unfolding Eq apply (simp del:get_if_const.simps) apply(cases "(MPoly_Type.degree p' x = Suc 0 ∨ MPoly_Type.degree p' x = 2)") defer using Cons apply simp
        apply (simp del:get_if_const.simps)
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 2)")
        apply(simp del:get_if_const.simps) using h
        apply simp
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 1)")
        apply(simp del:get_if_const.simps) using h
        apply simp
        apply(cases "check_nonzero_const (isolate_variable_sparse p' x 0)")
        apply(simp del:get_if_const.simps) using h
        apply simp
        using Cons by auto
    next
      case (Leq x3)
      then show ?thesis using Cons by auto
    next
      case (Neq x4)
      then show ?thesis using Cons by auto
    qed
  qed
  show ?thesis
    using elimVar_eq_2[OF assms(2) inset degree nonzero] Some assms by auto
qed  


lemma luckyFind'_eval : 
  assumes "length xs = var"
  shows "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (luckyFind' var L F) (xs @ x # Γ))"
proof(cases "find_lucky_eq var L")
  case None
  show ?thesis apply(simp add:eval_list_conj None)
    apply(rule ex_cong1)
    apply auto
    by (meson UnCI eval.simps(1) image_eqI)
next
  case (Some p)
  have "∃F'. luckyFind var L F = Some F'" by (simp add:Some)
  then obtain F' where F'_def: "luckyFind var L F = Some F'" by metis
  show ?thesis
    unfolding luckyFind_eval[OF F'_def assms] 
    using F'_def Some by auto
qed 



lemma luckiestFind_eval : 
  assumes "length xs = var"
  shows "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (luckiestFind var L F) (xs @ x # Γ))"
proof(cases "find_luckiest_eq var L")
  case None
  show ?thesis apply(simp add:eval_list_conj None)
    apply(rule ex_cong1)
    apply auto
    by (meson UnCI eval.simps(1) image_eqI)
next
  case (Some p)
  have h1: "Eq p ∈ set L"
    using Some apply(induction L arbitrary:p)
    apply simp
    subgoal for a L p
      apply(rule find_luckiest_eq.elims[of var "a#L" "Some p"])
      apply simp_all
      subgoal for v p'
        apply(cases "MPoly_Type.degree p' v = Suc 0 ∨ MPoly_Type.degree p' v = 2") apply simp_all 
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 2))") apply simp_all
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v (Suc 0)))") apply simp_all
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 0))") apply simp_all
        apply(cases "MPoly_Type.coeff (isolate_variable_sparse p' v (Suc 0)) 0 = 0 ⟶
        MPoly_Type.coeff (isolate_variable_sparse p' v 2) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 0) 0 ≠ 0") by simp_all
      done
    done
  have h2 : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
    using Some apply(induction L arbitrary:p)
    apply simp
    subgoal for a L p
      apply(rule find_luckiest_eq.elims[of var "a#L" "Some p"])
      apply simp_all
      subgoal for v p'
        apply(cases "MPoly_Type.degree p' v = Suc 0 ∨ MPoly_Type.degree p' v = 2") apply simp_all 
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 2))") apply simp_all
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v (Suc 0)))") apply simp_all
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 0))") apply simp_all
        apply(cases "MPoly_Type.coeff (isolate_variable_sparse p' v (Suc 0)) 0 = 0 ⟶
        MPoly_Type.coeff (isolate_variable_sparse p' v 2) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 0) 0 ≠ 0") by simp_all
      done
    done
  have h : "⋀p xa. check_nonzero_const p ⟹ insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0"
  proof-
    fix p xa
    assume h : "check_nonzero_const p"
    show "insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0"
      apply(cases "get_if_const p")
      using h get_if_const_insertion by simp_all
  qed

  have h3 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨
        insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨
        insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0"
    using Some apply(induction L arbitrary:p)
    apply simp
    subgoal for a L p
      apply(rule find_luckiest_eq.elims[of var "a#L" "Some p"])
      apply simp_all
      subgoal for v p'
        apply(cases "MPoly_Type.degree p' v = Suc 0 ∨ MPoly_Type.degree p' v = 2") apply simp_all 
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 2))") apply simp_all
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v (Suc 0)))") apply simp_all
        apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 0))") apply simp_all
        apply(cases "MPoly_Type.coeff (isolate_variable_sparse p' v (Suc 0)) 0 = 0 ⟶
        MPoly_Type.coeff (isolate_variable_sparse p' v 2) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 0) 0 ≠ 0") apply simp_all
        using h[of "isolate_variable_sparse p' v 0"] h[of "isolate_variable_sparse p' v (Suc 0)"] h[of "isolate_variable_sparse p' v 2"] apply simp
        by blast
      done
    done
  show ?thesis  apply(simp_all add:Some del:elimVar.simps)
    apply(rule elimVar_eq_2) using assms apply simp using h1 h2 h3 by auto

qed 

end

Theory EqualityVS

subsection "Overall Equality VS Proofs"
theory EqualityVS
  imports EliminateVariable LuckyFind
begin


lemma degree_find_eq :
  assumes "find_eq var L = (A,L')"
  shows "∀p∈set(A). MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using assms(1)
proof(induction L arbitrary: A L')
  case Nil
  then show ?case by auto
next
  case (Cons a L)
  then show ?case proof(cases a)
    case (Less p)
    {fix A' L' 
      assume h : "find_eq var L = (A', L')"
      have "A=A'"
        using Less Cons h by(simp)
      then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
        using Cons h by auto
    }
    then show ?thesis by (meson surj_pair)
  next
    case (Eq p)
    then show ?thesis proof(cases "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2")
      case True
      {fix A' L' 
        assume h : "find_eq var L = (A', L')"
        have "A= (p#A')"
          using Eq Cons h True by auto
        then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
          using Cons h True by auto
      }
      then show ?thesis by (meson surj_pair)
    next
      case False
      {fix A' L' 
        assume h : "find_eq var L = (A', L')"
        have "A=A'"
          using Eq Cons h False
          by (smt One_nat_def case_prod_conv find_eq.simps(3) less_2_cases less_SucE numeral_2_eq_2 numeral_3_eq_3 prod.sel(1))
        then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
          using Cons h by auto
      }
      then show ?thesis by (meson surj_pair)
    qed
  next
    case (Leq p)
    {fix A' L' 
      assume h : "find_eq var L = (A', L')"
      have "A=A'"
        using Leq Cons h by(simp)
      then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
        using Cons h by auto
    }
    then show ?thesis by (meson surj_pair)
  next
    case (Neq p)
    {fix A' L' 
      assume h : "find_eq var L = (A', L')"
      have "A=A'"
        using Neq Cons h by(simp)
      then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
        using Cons h by auto
    }
    then show ?thesis by (meson surj_pair)
  qed
qed

lemma list_in_find_eq :
  assumes "find_eq var L = (A,L')"
  shows "set(map Eq A @ L') = set L"using assms(1)
proof(induction L arbitrary: A L')
  case Nil
  then show ?case by auto
next
  case (Cons a L)
  then show ?case proof(cases a)
    case (Less p)
    {fix A' L'' 
      assume h : "find_eq var L = (A', L'')"
      have A : "A=A'"
        using Less Cons h by(simp)
      have L : "L'=Less p # L''"
        using Less Cons h by simp
      have "set (map Eq A @ L') = set (a # L)"
        apply(simp add: A L Less) using Cons(1)[OF h] by auto
    }
    then show ?thesis by (meson surj_pair)
  next
    case (Eq p)
    then show ?thesis proof(cases "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2")
      case True
      {fix A' L'' 
        assume h : "find_eq var L = (A', L'')"
        have A : "A=(p#A')"
          using Eq Cons h True by auto
        have L : "L'= L''"
          using Eq Cons h True by auto 
        have "set (map Eq A @ L') = set (a # L)"
          apply(simp add: A L Eq) using Cons(1)[OF h] by auto
      }
      then show ?thesis by (meson surj_pair)
    next
      case False
      {fix A' L'' 
        assume h : "find_eq var L = (A', L'')"
        have A : "A=A'"
          using Eq Cons h False
          by (smt case_prod_conv degree_find_eq find_eq.simps(3) list.set_intros(1) prod.sel(1))
        have L : "L'=Eq p # L''"
          using Eq Cons h
          by (smt A case_prod_conv find_eq.simps(3) not_Cons_self2 prod.sel(1) prod.sel(2)) 
        have "set (map Eq A @ L') = set (a # L)"
          apply(simp add: A L Eq) using Cons(1)[OF h] by auto
      }
      then show ?thesis by (meson surj_pair)
    qed
  next
    case (Leq p)
    {fix A' L'' 
      assume h : "find_eq var L = (A', L'')"
      have A : "A=A'"
        using Leq Cons h by(simp)
      have L : "L'=Leq p # L''"
        using Leq Cons h by simp
      have "set (map Eq A @ L') = set (a # L)"
        apply(simp add: A L Leq) using Cons(1)[OF h] by auto
    }
    then show ?thesis by (meson surj_pair)
  next
    case (Neq p)
    {fix A' L'' 
      assume h : "find_eq var L = (A', L'')"
      have A : "A=A'"
        using Neq Cons h by(simp)
      have L : "L'=Neq p # L''"
        using Neq Cons h by simp
      have "set (map Eq A @ L') = set (a # L)"
        apply(simp add: A L Neq) using Cons(1)[OF h] by auto
    }
    then show ?thesis by (meson surj_pair)
  qed
qed


lemma qe_eq_one_eval :
  assumes hlength : "length xs = var"
  shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval (qe_eq_one var L F) (xs @ (x#Γ))))"
proof(cases "find_eq var L")
  case (Pair A L')
  then show ?thesis proof(cases A)
    case Nil
    show ?thesis proof safe
      fix x
      assume h : "eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)"
      show "∃x. eval (qe_eq_one var L F) (xs @ x # Γ)" apply(simp) using Nil Pair h by auto 
    next
      fix x
      assume h : "eval (qe_eq_one var L F) (xs @ x # Γ)"
      show "∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)"
        apply(rule exI[where x="x"]) using Nil Pair h by auto
    qed
  next
    case (Cons p A')
    have "set(map Eq (p # A') @ L') = set L"
      using list_in_find_eq[OF Pair] Cons by auto
    then have in_p: "Eq p ∈ set (L)"
      by auto
    have "p∈(set A)" using Cons by auto
    then have low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" 
      using degree_find_eq[OF Pair] by auto
    have "(∃x.(eval (qe_eq_one var L F) (xs @ (x#Γ)))) = 
          (∃x.(eval (Or (And (Neg (split_p var p))
                      ((elimVar var L F) (Eq p))
                    )
                    (And (split_p var p) 
                      (list_conj (map Atom ((map Eq A')  @ L') @ F))
                    )) (xs @ (x#Γ))))"
      apply(rule ex_cong1) apply(simp only: qe_eq_one.simps) using Pair Cons  by auto
    also have "... = (∃x. ((¬eval (split_p var p) (xs @ x # Γ)) ∧ eval (elimVar var L F (Eq p)) (xs @ x # Γ)) ∨
         eval (split_p var p) (xs @ x # Γ) ∧
         (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ)))"
      by(simp add: eval_list_conj)
    also have "... = (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ))"
    proof(cases "∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨
      insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨
      insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0")
      case True
      have "(∃x. ((¬eval (split_p var p) (xs @ x # Γ)) ∧ eval (elimVar var L F (Eq p)) (xs @ x # Γ)) ∨
         eval (split_p var p) (xs @ x # Γ) ∧
         (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ))) =
        (∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))"
      proof safe
        fix x
        assume "eval (elimVar var L F (Eq p)) (xs @ x # Γ)"
        then show "∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)" by auto
      next
        fix x
        assume h : "eval (split_p var p) (xs @ x # Γ)"
        have "¬ eval (split_p var p) (xs @ x # Γ)"
          using True by simp 
        then show "∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)" using h by simp
      next
        fix x
        assume "eval (elimVar var L F (Eq p)) (xs @ x # Γ)"
        then show "∃x. ¬ eval (split_p var p) (xs @ x # Γ) ∧ eval (elimVar var L F (Eq p)) (xs @ x # Γ) ∨
             eval (split_p var p) (xs @ x # Γ) ∧
             (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ))"
          by auto
      qed
      then show ?thesis using elimVar_eq_2[OF hlength in_p low_pow True] by simp
    next
      case False
      have h1: "∀x. eval (split_p var p) (xs @ x # Γ)"
        using False apply(simp) using not_in_isovarspar
        by (metis hlength insertion_lowerPoly1)
      have "set(map Eq (p # A') @ L') = set L"
        using list_in_find_eq[OF Pair] Cons by auto
      then have h5 : "set(map fm.Atom (map Eq (p # A') @ L') @ F) = set(map fm.Atom L @ F)"
        by auto
      have h4 : "(∃x. (aEval (Eq p) (xs @ x # Γ)) ∧
         (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ))) = 
          (∃x.(∀f∈set (map fm.Atom (map Eq (p#A') @ L') @ F). eval f (xs @ x # Γ)))"
        by(simp)
      have h2 : "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. (aEval (Eq p) (xs @ x # Γ)) ∧
         (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ)))"
        by(simp only: h4 h5 eval_list_conj) 
      have h3 : "∀x. (aEval (Eq p) (xs @ x # Γ))"
      proof-
        define A where "A = (isolate_variable_sparse p var 2)"
        define B where "B = (isolate_variable_sparse p var 1)"
        define C where "C = (isolate_variable_sparse p var 0)"
        have freeA : "var ∉ vars A"
          unfolding A_def
          by (simp add: not_in_isovarspar)
        have freeB : "var ∉ vars B"
          unfolding B_def
          by (simp add: not_in_isovarspar)
        have freeC : "var ∉ vars C"
          unfolding C_def
          by (simp add: not_in_isovarspar)
        have express_p : "p = A*(Var var)^2+B*(Var var)+C"
          using express_poly[OF low_pow] unfolding A_def B_def C_def
          by fastforce
        have xlength : "∀x. (insertion (nth_default 0 (xs @ x # Γ)) (Var var))= x" 
          using hlength insertion_var
          by (metis add.commute add_strict_increasing length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl)
        fix x
        define c where "c i = (insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var i))" for i
        have c2 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = c 2" 
          using freeA apply(simp add: A_def c_def)
          by (simp add: hlength insertion_lowerPoly1)
        have c1 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = c 1"
          using freeB apply(simp add: B_def c_def)
          by (simp add: hlength insertion_lowerPoly1)
        have c0 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = c 0"
          using freeC apply(simp add: C_def c_def)
          by (simp add: hlength insertion_lowerPoly1)
        have sum : "∀x. c 2 * x2 + c (Suc 0) * x + c 0 = (∑i≤2. c i * x ^ i)"
          by (simp add: numerals(2))  
        show ?thesis unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow xlength)
          apply(simp add:c2 c1 c0 sum polyfun_eq_0[where c="c", where n="2"])
          using False apply(simp)
          by (metis A_def B_def C_def One_nat_def c0 c1 c2 le_SucE le_zero_eq numeral_2_eq_2)
      qed
      show ?thesis apply(simp only: h1 h2) using h3 by(simp)
    qed
    finally show ?thesis by auto
  qed
qed    




lemma qe_eq_repeat_helper_eval_case1 :
  assumes hlength : "length xs = var"
  assumes degreeGood : "∀p∈set(A). MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
  shows "((eval (list_conj ((map (Atom o Eq)  A) @ (map Atom L) @ F)) (xs @ (x#Γ)))) 
        ⟹ (eval (qe_eq_repeat_helper var A L F) (xs @ x # Γ))"
proof(induction A rule : in_list_induct)
  case Nil
  then show ?case by auto
next
  case (Cons p A')
  assume assm : "((eval (list_conj ((map (Atom o Eq) (p#A')) @ (map Atom L) @ F)) (xs @ (x#Γ)))) "
  then have h :  "insertion (nth_default 0 (xs @ x # Γ)) p = 0 ∧ (eval (qe_eq_repeat_helper var A' L F) (xs @ x # Γ))"
    using Cons by(simp add: eval_list_conj)
  have "¬ eval (split_p var p) (xs @ x # Γ) ∧ eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ) ∨
    eval (split_p var p) (xs @ x # Γ) ∧ eval (qe_eq_repeat_helper var A' L F) (xs @ x # Γ)"
  proof(cases "eval (split_p var p) (xs @ x # Γ)")
    case True
    then show ?thesis using h by blast
  next
    case False
    have all0 :  " ∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨
      insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨
      insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0"
      using False  apply(simp) using not_in_isovarspar
      by (metis hlength insertion_lowerPoly1)
    have in_p : "Eq p∈set((map Eq (p # A') @ L))"
      by auto
    have "p∈(set A)" using Cons by auto
    then have low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" 
      using degreeGood by auto
    have list_manipulate : "map fm.Atom (map Eq (p # A') @ L) = map (fm.Atom ∘ Eq) (p # A') @ map fm.Atom L"
      by(simp)
    have "eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ)"
      using elimVar_eq_2[OF hlength in_p low_pow all0, where F="F"] apply(simp only: list_manipulate) 
      using assm freeIn_elimVar_eq[where var="var", where L="(map Eq (p # A') @ L)", where F="F", where p="p"]
      by (metis append.assoc hlength list_update_length var_not_in_eval)
    then show ?thesis apply(simp only: False) by blast
  qed
  then show ?case by(simp only: qe_eq_repeat_helper.simps eval.simps)
qed

lemma qe_eq_repeat_helper_eval_case2 :
  assumes hlength : "length xs = var"
  assumes degreeGood : "∀p∈set(A). MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
  shows "(eval (qe_eq_repeat_helper var A L F) (xs @ x # Γ))
        ⟹ ∃x. ((eval (list_conj ((map (Atom o Eq)  A) @ (map Atom L) @ F)) (xs @ (x#Γ))))"
proof(induction A rule : in_list_induct)
  case Nil
  then show ?case apply(simp) apply(rule exI[where x=x]) by simp
next
  case (Cons p A')
  have h : "¬ eval (split_p var p) (xs @ x # Γ) ∧ eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ) ∨
    eval (split_p var p) (xs @ x # Γ) ∧ eval (qe_eq_repeat_helper var A' L F) (xs @ x # Γ)"
    using Cons by(simp only:qe_eq_repeat_helper.simps eval.simps)
  have "p∈set(A)" using Cons(1) .
  then have degp : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" 
    using degreeGood by auto
  show ?case proof(cases "eval (split_p var p) (xs @ x # Γ)")
    case True
    have "∃x. eval (list_conj (map (fm.Atom ∘ Eq) A' @ map fm.Atom L @ F)) (xs @ x # Γ)"
      using h True Cons by blast
    then obtain x where x_def : "eval (list_conj (map (fm.Atom ∘ Eq) A' @ map fm.Atom L @ F)) (xs @ x # Γ)" by metis
    define A where "A = (isolate_variable_sparse p var 2)"
    define B where "B = (isolate_variable_sparse p var 1)"
    define C where "C = (isolate_variable_sparse p var 0)"
    have express_p : "p = A * Var var ^2+B * Var var+C"
    proof(cases "MPoly_Type.degree p var = 1")
      case True
      have a0 : "A = 0" apply(simp add: A_def) using True
        by (simp add: isovar_greater_degree) 
      show ?thesis using sum_over_zero[where mp="p", where x="var"] apply(subst (asm) True) by(simp add:a0 B_def C_def add.commute)
    next
      case False
      then have deg : "MPoly_Type.degree p var = 2" using degp by blast
      have flip : "A * (Var var)2 + B * Var var + C = C + B * Var var + A * (Var var)^2" using add.commute by auto
      show ?thesis using sum_over_zero[where mp="p", where x="var"] apply(subst (asm) deg) apply(simp add: flip) apply(simp add: A_def B_def C_def)
        by (simp add: numeral_2_eq_2)
    qed
    have insert_x : "insertion (nth_default 0 (xs @ x # Γ)) (Var var) = x" using hlength
      by (metis add.commute add_strict_increasing insertion_var length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl)

    have h : "(aEval (Eq p) (xs @ x # Γ))"
    proof-
      have freeA : "var ∉ vars A"
        unfolding A_def
        by (simp add: not_in_isovarspar)
      have freeB : "var ∉ vars B"
        unfolding B_def
        by (simp add: not_in_isovarspar)
      have freeC : "var ∉ vars C"
        unfolding C_def
        by (simp add: not_in_isovarspar)
      have xlength : "(insertion (nth_default 0 (xs @ x # Γ)) (Var var))= x" 
        using hlength insertion_var
        using insert_x by blast
      define c where "c i = (insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var i))" for i
      have c2 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = c 2" 
        using freeA apply(simp add: A_def c_def)
        by (simp add: hlength insertion_lowerPoly1)
      have c1 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = c 1"
        using freeB apply(simp add: B_def c_def)
        by (simp add: hlength insertion_lowerPoly1)
      have c0 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = c 0"
        using freeC apply(simp add: C_def c_def)
        by (simp add: hlength insertion_lowerPoly1)
      have sum : "c 2 * x2 + c (Suc 0) * x + c 0 = (∑i≤2. c i * x ^ i)"
        by (simp add: numerals(2))  
      show ?thesis apply(subst express_p) apply(simp add:insertion_add insertion_mult insertion_pow xlength)
        apply(simp add:c2 c1 c0 sum polyfun_eq_0[where c="c", where n="2"])
        using True apply(simp) using le_SucE numeral_2_eq_2
        by (metis (no_types) A_def B_def C_def One_nat_def add.left_neutral c0 c1 c2 mult_zero_class.mult_zero_left sum)
    qed
    show ?thesis apply(rule exI[where x=x]) using x_def h apply(simp only:eval_list_conj) by(simp)
  next
    case False
    have all0 :  " ∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨
      insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨
      insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0"
      using False  apply(simp) using not_in_isovarspar
      by (metis hlength insertion_lowerPoly1)
    have h : "eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ)"
      using False h by blast
    have in_list : "Eq p ∈ set (((map Eq (p# A')) @ L))"
      by(simp)
    show ?thesis using elimVar_eq_2[OF hlength in_list, where F="F", OF degp all0] h
      by (metis append_assoc map_append map_map)
  qed
qed



lemma qe_eq_repeat_eval :
  assumes hlength : "length xs = var"
  shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval (qe_eq_repeat var L F) (xs @ (x#Γ))))"
proof(cases "luckyFind var L F")
  case None
  then show ?thesis proof(cases "find_eq var L")
    case (Pair A L')
    have degGood : "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2"
      using degree_find_eq[OF Pair] .
    have "(∃x. eval (qe_eq_repeat var L F) (xs @ x # Γ)) =(∃x. eval
        (qe_eq_repeat_helper var A L' F)
        (xs @ x # Γ))"
      using Pair None by auto
    also have "...
      = (∃x. ((eval (list_conj ((map (Atom o Eq)  A) @ (map Atom L') @ F)) (xs @ (x#Γ)))))"
      using qe_eq_repeat_helper_eval_case1[OF hlength degGood, where L="L'", where F="F", where Γ="Γ"]
        qe_eq_repeat_helper_eval_case2[OF hlength degGood, where L="L'", where F="F", where Γ="Γ"]
      by blast
    also have "... = (∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ))))"
    proof-
      have list_manipulate : "map (fm.Atom ∘ Eq) A @ map fm.Atom L' = map fm.Atom (map Eq A @ L')"
        by simp
      have changeA :  "map (fm.Atom ∘ Eq) A = map Atom (map Eq A)" by auto
      have split : "(∃x. ∀f∈set ((map (fm.Atom ∘ Eq) A) @
                (map fm.Atom L') @ F).
          eval f (xs @ x # Γ)) = (∃x. ∀f∈ (Atom ` set ((map (Eq) A) @ L')) ∪ set(F).
          eval f (xs @ x # Γ))"
        apply (rule ex_cong1)
        apply(subst changeA)
        by auto
      show ?thesis apply(simp only: eval_list_conj split list_in_find_eq[OF Pair]) by auto
    qed
    finally have ?thesis by simp
    then show ?thesis by auto
  qed
next
  case (Some a)
  then show ?thesis using luckyFind_eval[OF Some assms(1)] by auto
qed


end

Theory UniAtoms

section "General VS Proofs"
subsection "Univariate Atoms"
theory UniAtoms
  imports Debruijn
begin

datatype atomUni = LessUni "real * real * real" | EqUni "real * real * real" | LeqUni "real * real * real" | NeqUni "real * real * real"
datatype (atoms: 'a) fmUni =
  TrueFUni | FalseFUni | AtomUni 'a | AndUni "'a fmUni" "'a fmUni" | OrUni "'a fmUni" "'a fmUni" 

fun aEvalUni :: "atomUni ⇒ real ⇒ bool" where
  "aEvalUni (EqUni (a,b,c)) x = (a*x^2+b*x+c = 0)" |
  "aEvalUni (LessUni (a,b,c)) x = (a*x^2+b*x+c < 0)" |
  "aEvalUni (LeqUni (a,b,c)) x = (a*x^2+b*x+c ≤ 0)" |
  "aEvalUni (NeqUni (a,b,c)) x = (a*x^2+b*x+c ≠ 0)"

fun aNegUni :: "atomUni ⇒ atomUni" where
  "aNegUni (LessUni (a,b,c)) = LeqUni (-a,-b,-c)" |
  "aNegUni (EqUni p) = NeqUni p" |
  "aNegUni (LeqUni (a,b,c)) = LessUni (-a,-b,-c)" |
  "aNegUni (NeqUni p) = EqUni p"


fun evalUni :: "atomUni fmUni ⇒ real ⇒ bool" where
  "evalUni (AtomUni a) x = aEvalUni a x" |
  "evalUni (TrueFUni) _ = True" |
  "evalUni (FalseFUni) _ = False" |
  "evalUni (AndUni φ ψ) x = ((evalUni φ x) ∧ (evalUni ψ x))" |
  "evalUni (OrUni φ ψ) x = ((evalUni φ x) ∨ (evalUni ψ x))"


fun negUni :: "atomUni fmUni ⇒ atomUni fmUni" where
  "negUni (AtomUni a) = AtomUni(aNegUni a)" |
  "negUni (TrueFUni) = FalseFUni" |
  "negUni (FalseFUni) = TrueFUni" |
  "negUni (AndUni φ ψ) = (OrUni (negUni φ) (negUni ψ))" |
  "negUni (OrUni φ ψ) = (AndUni (negUni φ) (negUni ψ))"

fun convert_poly :: "nat ⇒ real mpoly ⇒ real list ⇒ (real * real * real) option" where
  "convert_poly var p xs = (
  if MPoly_Type.degree p var < 3
  then let (A,B,C) = get_coeffs var p in Some(insertion (nth_default 0 (xs)) A,insertion (nth_default 0 (xs)) B,insertion (nth_default 0 (xs)) C)
 else None)"

fun convert_atom :: "nat ⇒ atom ⇒ real list ⇒ atomUni option" where
  "convert_atom var (Less p) xs = map_option LessUni (convert_poly var p xs)"|
  "convert_atom var (Eq p) xs = map_option EqUni (convert_poly var p xs)"|
  "convert_atom var (Leq p) xs = map_option LeqUni (convert_poly var p xs)"|
  "convert_atom var (Neq p) xs = map_option NeqUni (convert_poly var p xs)"

lemma convert_atom_change :
  assumes "length xs' = var"
  shows "convert_atom var At (xs' @ x # Γ) = convert_atom var At (xs' @ x' # Γ)"
  apply(cases At)using assms apply simp_all
  by (metis insertion_lowerPoly1 not_in_isovarspar)+

lemma degree_convert_eq : 
  assumes "convert_poly var p xs = Some(a)"
  shows "MPoly_Type.degree p var < 3"
  using assms apply(cases "MPoly_Type.degree p var < 3") by auto

lemma poly_to_univar :
  assumes "MPoly_Type.degree p var < 3"
  assumes "get_coeffs var p = (A,B,C)"
  assumes "a = insertion (nth_default 0 (xs'@y#xs)) A"
  assumes "b = insertion (nth_default 0 (xs'@y#xs)) B"
  assumes "c = insertion (nth_default 0 (xs'@y#xs)) C"
  assumes "length xs' = var"
  shows "insertion (nth_default 0 (xs'@x#xs)) p = (a*x^2)+(b*x)+c"
proof-
  have ha: "⋀x. a = insertion (nth_default 0 (xs'@x # xs)) A" using assms(2) apply auto
    by (metis assms(3) assms(6) insertion_lowerPoly1 not_in_isovarspar)
  have hb: "⋀x. b = insertion (nth_default 0 (xs'@x # xs)) B" using assms(2) apply auto
    by (metis assms(4) assms(6) insertion_lowerPoly1 not_in_isovarspar)
  have hc: "⋀x. c = insertion (nth_default 0 (xs'@x # xs)) C" using assms(2) apply auto
    by (metis assms(5) assms(6) insertion_lowerPoly1 not_in_isovarspar)
  show ?thesis
  proof(cases "MPoly_Type.degree p var = 0")
    case True
    have h1 : "var < length (xs'@x#xs)" using assms by auto
    show ?thesis using assms ha hb hc sum_over_degree_insertion[OF h1 True, of y] apply(simp add: isovar_greater_degree[of p ] True)
      using True degree0isovarspar by force
  next
    case False
    then have notzero : "MPoly_Type.degree p var ≠ 0" by auto
    show ?thesis proof(cases "MPoly_Type.degree p var = 1" )
      case True
      have h1 : "var < length (xs'@x#xs)" using assms by auto
      show ?thesis using  sum_over_degree_insertion[OF h1 True, of x,  symmetric] unfolding assms(6)[symmetric] list_update_length unfolding assms(6) apply simp using ha hb hc assms apply auto
        by (smt (verit, ccfv_threshold) One_nat_def True express_poly h1 insertion_add insertion_mult insertion_pow insertion_var list_update_length)    
    next
      case False
      then have deg2 : "MPoly_Type.degree p var = 2" using notzero assms by auto
      have h1 : "var < length (xs'@x#xs)" using assms by auto
      have two : "2 = Suc(Suc 0)" by auto
      show ?thesis
        using  sum_over_degree_insertion[OF h1 deg2, of x,  symmetric] unfolding assms(6)[symmetric] list_update_length unfolding assms(6) two apply simp using ha hb hc assms apply auto
        using deg2 express_poly h1 insertion_add insertion_mult insertion_pow insertion_var list_update_length
        by (smt (verit, best) numeral_2_eq_2)
    qed
  qed
qed

lemma "aEval_aEvalUni":
  assumes "convert_atom var a (xs'@x#xs) = Some a'"
  assumes "length xs' = var"
  shows "aEval a (xs'@x#xs) = aEvalUni a' x"
proof(cases a)
  case (Less x)
  then show ?thesis
  proof(cases "MPoly_Type.degree x var < 3")
    case True
    then show ?thesis
      using assms apply(simp add:Less)
      using poly_to_univar[OF True]
      by (metis One_nat_def aEvalUni.simps(2) get_coeffs.elims) 
  next
    case False
    then show ?thesis using assms Less by auto
  qed
next
  case (Eq x)
  then show ?thesis
  proof(cases "MPoly_Type.degree x var < 3")
    case True
    then show ?thesis
      using assms apply(simp add:Eq)
      using poly_to_univar[OF True]
      by (metis One_nat_def aEvalUni.simps(1) get_coeffs.elims) 
  next
    case False
    then show ?thesis using assms Eq by auto
  qed
next
  case (Leq x)
  then show ?thesis
  proof(cases "MPoly_Type.degree x var < 3")
    case True
    then show ?thesis
      using assms apply(simp add:Leq)
      using poly_to_univar[OF True]
      by (metis One_nat_def aEvalUni.simps(3) get_coeffs.elims) 
  next
    case False
    then show ?thesis using assms Leq by auto
  qed
next
  case (Neq x)
  then show ?thesis
  proof(cases "MPoly_Type.degree x var < 3")
    case True
    then show ?thesis
      using assms apply(simp add:Neq)
      using poly_to_univar[OF True]
      by (metis One_nat_def aEvalUni.simps(4) get_coeffs.elims) 
  next
    case False
    then show ?thesis using assms Neq by auto
  qed
qed


fun convert_fm :: "nat ⇒ atom fm ⇒ real list ⇒ (atomUni fmUni) option" where
  "convert_fm var (Atom a) Γ = map_option (AtomUni) (convert_atom var a Γ)" |
  "convert_fm var (TrueF) _ = Some TrueFUni" |
  "convert_fm var (FalseF) _ = Some FalseFUni" |
  "convert_fm var (And φ ψ) Γ = (case ((convert_fm var φ Γ),(convert_fm var ψ Γ)) of (Some a, Some b) ⇒ Some (AndUni a b) | _ ⇒ None)" |
  "convert_fm var (Or φ ψ) Γ = (case ((convert_fm var φ Γ),(convert_fm var ψ Γ)) of (Some a, Some b) ⇒ Some (OrUni a b) | _ ⇒ None)" |
  "convert_fm var (Neg φ) Γ = None " |
  "convert_fm var (ExQ φ) Γ = None" |
  "convert_fm var (AllQ φ) Γ = None"|
  "convert_fm var (AllN i φ) Γ = None"|
  "convert_fm var (ExN i φ) Γ = None"


lemma "eval_evalUni":
  assumes "convert_fm var F (xs'@x#xs) = Some F'"
  assumes "length xs' = var"
  shows "eval F (xs'@x#xs) = evalUni F' x"
  using assms
proof(induction F arbitrary: F')
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  then show ?case using aEval_aEvalUni by auto
next
  case (And F1 F2)
  then show ?case apply(cases "convert_fm var F1 (xs'@x#xs)") apply simp apply(cases "convert_fm var F2 (xs'@x#xs)") by auto
next
  case (Or F1 F2)
  then show ?case apply(cases "convert_fm var F1 (xs'@x#xs)") apply simp apply(cases "convert_fm var F2 (xs'@x#xs)") by auto
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  then show ?case by auto
next
  case (AllQ F)
  then show ?case by auto
next
  case (ExN x1 φ)
  then show ?case by auto
next
  case (AllN x1 φ)
  then show ?case by auto
qed

fun grab_atoms :: "nat ⇒ atom fm ⇒ atom list option" where
  "grab_atoms var TrueF = Some([])" |
  "grab_atoms var FalseF = Some([])" |
  "grab_atoms var (Atom(Eq p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Eq p]) else Some([])) else None)"|
  "grab_atoms var (Atom(Less p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Less p]) else Some([])) else None)"|
  "grab_atoms var (Atom(Leq p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Leq p]) else Some([])) else None)"|
  "grab_atoms var (Atom(Neq p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Neq p]) else Some([])) else None)"|
  "grab_atoms var (And a b) = (
case grab_atoms var a of 
  Some(al) ⇒ (
    case grab_atoms var b of
      Some(bl) ⇒ Some(al@bl)
    | None ⇒ None
  )
| None ⇒ None
)"|
  "grab_atoms var (Or a b) = (
case grab_atoms var a of 
  Some(al) ⇒ (
    case grab_atoms var b of
      Some(bl) ⇒ Some(al@bl)
    | None ⇒ None
  )
| None ⇒ None
)"|

"grab_atoms var (Neg _) = None"|
"grab_atoms var (ExQ _) = None"|
"grab_atoms var (AllQ _) = None"|
"grab_atoms var (AllN i _) = None"|
"grab_atoms var (ExN i _) = None"



lemma nil_grab : "(grab_atoms var F = Some []) ⟹ (freeIn var F)"
proof(induction F)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  then show ?case proof(cases x)
    case (Less p)
    then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto
      using degree0isovarspar not_in_isovarspar by blast
  next
    case (Eq p)
    then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto
      using degree0isovarspar not_in_isovarspar by blast
  next
    case (Leq p)
    then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto
      using degree0isovarspar not_in_isovarspar by blast
  next
    case (Neq p)
    then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto
      using degree0isovarspar not_in_isovarspar by blast
  qed
next
  case (And F1 F2)
  then show ?case apply(cases "grab_atoms var F1")
    apply(cases "grab_atoms var F2") apply(auto)
    apply(cases "grab_atoms var F2") apply(auto)
    apply(cases "grab_atoms var F2") by(auto)
next
  case (Or F1 F2)
  then show ?case apply(cases "grab_atoms var F1")
    apply(cases "grab_atoms var F2") apply(auto)
    apply(cases "grab_atoms var F2") apply(auto)
    apply(cases "grab_atoms var F2") by(auto)
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  then show ?case by auto
next
  case (AllQ F)
  then show ?case by auto
next
  case (ExN x1 F)
  then show ?case by auto
next
  case (AllN x1 F)
  then show ?case by auto
qed

fun isSome :: "'a option ⇒ bool" where
  "isSome (Some _) = True" |
  "isSome None = False"

lemma "grab_atoms_convert" : "(isSome (grab_atoms var F)) = (isSome (convert_fm var F xs))"
proof(induction F)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom a)
  then show ?case apply(cases a) by auto
next
  case (And F1 F2)
  then show ?case
    by (smt convert_fm.simps(4) grab_atoms.simps(7) isSome.elims(2) isSome.elims(3) option.distinct(1) option.simps(5) option.split_sel_asm prod.simps(2)) 
next
  case (Or F1 F2)
  then show ?case
    by (smt convert_fm.simps(5) grab_atoms.simps(8) isSome.elims(2) isSome.elims(3) option.distinct(1) option.simps(5) option.split_sel_asm prod.simps(2))
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  then show ?case by auto
next
  case (AllQ F)
  then show ?case by auto
next
  case (ExN x1 F)
  then show ?case by auto
next
  case (AllN x1 F)
  then show ?case by auto
qed

lemma convert_aNeg :
  assumes "convert_atom var A (xs'@x#xs) = Some(A')"
  assumes "length xs' = var"
  shows "aEval (aNeg A) (xs'@x#xs) = aEvalUni (aNegUni A') x"
proof-
  have "aEval (aNeg A) (xs'@x#xs) = (¬ aEval A (xs'@x#xs))"
    using aNeg_aEval[of A "(xs'@x#xs)"] by auto
  also have "... = (¬ aEvalUni A' x)"
    using assms aEval_aEvalUni by auto
  also have "... = aEvalUni (aNegUni A') x"
    by(cases A')(auto)
  finally show ?thesis .
qed

lemma convert_neg : 
  assumes "convert_fm var F (xs'@x#xs) = Some(F')"
  assumes "length xs' = var"
  shows "eval (Neg F) (xs'@x#xs) = evalUni (negUni F') x"
  using assms
proof(induction F arbitrary:F')
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom p)
  then show ?case
    using convert_aNeg[of _ p]
    by (smt aNeg_aEval convert_fm.simps(1) evalUni.simps(1) eval.simps(1) eval.simps(6) map_option_eq_Some negUni.simps(1)) 
next
  case (And F1 F2)
  then show ?case apply auto
    apply (metis (no_types, lifting) evalUni.simps(5) negUni.simps(4) option.case_eq_if option.collapse option.distinct(1) option.sel)
    apply (smt (verit, del_insts) evalUni.simps(5) isSome.elims(1) negUni.simps(4) option.inject option.simps(4) option.simps(5))
    by (smt (verit, del_insts) evalUni.simps(5) isSome.elims(1) negUni.simps(4) option.inject option.simps(4) option.simps(5))
next
  case (Or F1 F2)
  then show ?case apply auto
    apply (smt (verit, del_insts) evalUni.simps(4) isSome.elims(1) negUni.simps(5) option.inject option.simps(4) option.simps(5))
    apply (smt (verit, del_insts) evalUni.simps(4) isSome.elims(1) negUni.simps(5) option.inject option.simps(4) option.simps(5))
    by (smt (verit, del_insts) evalUni.simps(4) isSome.elims(1) negUni.simps(5) option.inject option.simps(4) option.simps(5))
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  then show ?case by auto
next
  case (AllQ F)
  then show ?case by auto
next
  case (ExN x1 F)
  then show ?case by auto
next
  case (AllN x1 F)
  then show ?case by auto
qed


fun list_disj_Uni :: "'a fmUni list ⇒ 'a fmUni" where
  "list_disj_Uni [] = FalseFUni"|
  "list_disj_Uni (x#xs) = OrUni x (list_disj_Uni xs)"

fun list_conj_Uni :: "'a fmUni list ⇒ 'a fmUni" where
  "list_conj_Uni [] = TrueFUni"|
  "list_conj_Uni (x#xs) = AndUni x (list_conj_Uni xs)"

lemma eval_list_disj_Uni : "evalUni (list_disj_Uni L) x = (∃l∈set(L). evalUni l x)"
  by(induction L)(auto)

lemma eval_list_conj_Uni : "evalUni (list_conj_Uni A) x = (∀l∈set A. evalUni l x)"
  apply(induction A)by auto

lemma eval_list_conj_Uni_append : "evalUni (list_conj_Uni (A @ B)) x = (evalUni (list_conj_Uni (A)) x ∧ evalUni (list_conj_Uni (B)) x)"
  apply(induction A)by auto

fun map_atomUni :: "('a ⇒ 'a fmUni) ⇒ 'a fmUni ⇒ 'a fmUni" where
  "map_atomUni f (AtomUni a) = f a" |
  "map_atomUni f (TrueFUni) = TrueFUni" |
  "map_atomUni f (FalseFUni) = FalseFUni" |
  "map_atomUni f (AndUni φ ψ) = (AndUni (map_atomUni f φ) (map_atomUni f ψ))" |
  "map_atomUni f (OrUni φ ψ) = (OrUni (map_atomUni f φ) (map_atomUni f ψ))"

fun map_atom :: "(atom ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where
  "map_atom f TrueF = TrueF"|
  "map_atom f FalseF = FalseF"|
  "map_atom f (Atom a) = f a"|
  "map_atom f (And φ ψ) = And (map_atom f φ) (map_atom f ψ)"|
  "map_atom f (Or φ ψ) = Or (map_atom f φ) (map_atom f ψ)"|
  "map_atom f (Neg φ) = TrueF"|
  "map_atom f (ExQ φ) = TrueF"|
  "map_atom f (AllQ φ) = TrueF"|
  "map_atom f (ExN i φ) = TrueF"|
  "map_atom f (AllN i φ) = TrueF"

fun getPoly :: "atomUni => real * real * real" where
  "getPoly (EqUni p) = p"|
  "getPoly (LeqUni p) = p"|
  "getPoly (NeqUni p) = p"|
  "getPoly (LessUni p) = p"

lemma liftatom_map_atom : 
  assumes "∃F'. convert_fm var F xs = Some F'"
  shows "liftmap f F 0 = map_atom (f 0) F"
  using assms
  apply(induction F)
  apply(auto)
  apply fastforce
  apply (metis (no_types, lifting) isSome.elims(2) isSome.elims(3) option.case_eq_if)
  apply fastforce
  by (metis (no_types, lifting) isSome.elims(2) isSome.elims(3) option.case_eq_if)


lemma eval_map : "(∃l∈set(map f L). evalUni l x) = (∃l∈set(L). evalUni (f l) x)"
  by auto

lemma eval_map_all : "(∀l∈set(map f L). evalUni l x) = (∀l∈set(L). evalUni (f l) x)"
  by auto

lemma eval_append : "(∃l∈set (A#B).evalUni l x) = (evalUni A x ∨ (∃l∈set (B).evalUni l x))"
  by auto

lemma eval_conj_atom : "evalUni (list_conj_Uni (map AtomUni L)) x = (∀l∈set(L). aEvalUni l x)"
  unfolding eval_list_conj_Uni
  by auto
end

Theory NegInfinity

subsection "Negative Infinity"
theory NegInfinity
  imports "HOL-Analysis.Poly_Roots" VSAlgos
begin



lemma freeIn_allzero : "freeIn var (allZero p var)"
  by (simp add: not_in_isovarspar freeIn_list_conj)

lemma allzero_eval :
  assumes lLength : "var < length L"
  shows"(∃x. ∀y<x. aEval (Eq p) (list_update L var y) ) = (∀x. eval (allZero p var) (list_update L var x))"
proof-
  define n where "n = MPoly_Type.degree p var"
  define k where "k i x =((insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i)))" for i x
  {fix x
    have "(eval (allZero p var) (list_update L var x)) =
        (∀i∈{0..<(MPoly_Type.degree p var)+1}. aEval (Eq(isolate_variable_sparse p var i)) (list_update L var x))"
      by (simp add: eval_list_conj atLeast0_lessThan_Suc)
    also have "... = (∀i∈{0..<(MPoly_Type.degree p var)+1}. (insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i))=0)"
      by simp
    also have "... = (∀i≤(MPoly_Type.degree p var). (insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i))=0)"
      by fastforce
    also have "... = (∀y. (∑i≤(MPoly_Type.degree p var). ((insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i)) * y ^ i))=0)"
      using polyfun_eq_const[where n="MPoly_Type.degree p var", where k="0", where c="λi. (insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i))"]
      by (metis (no_types, lifting) le_add2 le_add_same_cancel2)
    also have "... = (∀y. (∑i≤n. (k i x) * y ^ i)=0)"
      using k_def n_def by simp
    finally have  "(eval (allZero p var) (list_update L var x)) = (∀y. (∑i≤n. (k i x) * y ^ i)=0)"
      by simp
  }
  then have h1 : "(∀x. (eval (allZero p var) (list_update L var x))) = (∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))"
    by simp

  have "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0) = (∃y. ∀x<y. (∑i≤(MPoly_Type.degree p var). (insertion (nth_default 0 (list_update L var x))(isolate_variable_sparse p var i))* x^i)= 0)"
    using k_def n_def by simp
  also have "... = (∃y. ∀x<y. insertion (nth_default 0 (list_update L var x)) (∑i≤(MPoly_Type.degree p var). (isolate_variable_sparse p var i)* Var var^i)= 0)"
    by(simp add: insertion_sum' insertion_mult insertion_pow insertion_var lLength)
  also have "... = (∃y. ∀x<y. insertion (nth_default 0 (list_update L var x)) p = 0)"
    using sum_over_zero  by simp
  also have "... = (∃y. ∀x<y. aEval (Eq p) (list_update L var x))"
    by simp
  finally have h2 : "(∃y. ∀x<y. aEval (Eq p) (list_update L var x)) = (∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0)"
    by simp

  have k_all : "∀x y i. k i x = k i y"
    unfolding k_def
    by (simp add: insertion_isovarspars_free)
  have h3a : "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0) ⟹ (∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))"
  proof-
    assume h : "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0)"
    {fix z y
      assume h : "(∀x<y. (∑i≤n. (k i x)* x^i)= 0)"
      have "∀x<y.∀i≤n. k i x = k i z"
        unfolding k_def
        using insertion_isovarspars_free by blast
      then have * : "∀x<y.∀i≤n. k i x * x ^ i = k i z * x^i"
        by auto
      then have "∀x<y. (∑i≤n. k i x * x ^ i) = (∑i≤n. k i z * x ^ i)"
        by (metis (no_types, lifting) k_all sum.cong)
      then have "∀x<y. (∑i≤n. (k i z)* x^i)= 0"
        using h  by simp
      then have "¬(finite {x. (∑i≤n. k i z * x ^ i) = 0})"
        using infinite_Iio[where a="y"]  Inf_many_def[where P="λx. (∑i≤n. k i z * x ^ i) = 0"]
        by (smt INFM_iff_infinite frequently_mono lessThan_def)
      then have "∀i≤n. k i z = 0"
        using  polyfun_rootbound[where n="n",  where c = "λi. k i z" ]
        by blast
    }
    then have "∀x.∀i≤n. k i x = 0"
      using h
      by (meson gt_ex)
    then show ?thesis by simp
  qed
  have h3b : "(∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0)) ⟹ (∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0)"
  proof-
    assume h : "(∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))"
    {fix z y x
      have "(∑i≤n. (k i z)* x^i)= 0"
        using h k_all by blast
      then have "∀i≤n. k i z = 0"
        using polyfun_eq_const[where k="0", where c = "λi. k i z", where n="n"]
        by (metis h)
    }
    then have "∀x.∀i≤n. k i x = 0"
      by (meson gt_ex)
    then show ?thesis by simp
  qed
  have h3 : "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0) = (∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))"
    using h3a h3b by auto
  show ?thesis using h1 h2 h3 by simp
qed




lemma freeIn_altNegInf : "freeIn var (alternateNegInfinity p var)"
proof-
  have h1 : "∀i. var ∉ (vars (if (i::nat) mod 2 = 0 then (Const(1)::real mpoly) else (Const(-1)::real mpoly)))"
    using var_not_in_Const[where var = "var", where x="1"] var_not_in_Const[where var = "var", where x="-1"]
    by simp
  define g where "g = (λF.λi.
    let a_n = isolate_variable_sparse p var i in
    let exp = (if i mod 2 = 0 then Const(1) else Const(-1)) in
      or (Atom(Less (exp * a_n)))
        (and (Atom (Eq a_n)) F)
    )"
  have h3 : "∀i. ∀F. (freeIn var F ⟶ freeIn var (g F i))"
    using g_def h1
    by (smt PolyAtoms.and_def not_in_isovarspar PolyAtoms.or_def freeIn.simps(1) freeIn.simps(2) freeIn.simps(7) freeIn.simps(8) not_in_mult) 
  define L where "L = ([0..<((MPoly_Type.degree p var)+1)])"
  have "∀F. freeIn var F ⟶ freeIn var (foldl (g::atom fm ⇒ nat ⇒ atom fm) F (L::nat list))"
  proof(induction L)
    case Nil
    then show ?case by simp
  next
    case (Cons a L)
    then show ?case using h3 by simp
  qed
  then have "freeIn var (foldl g FalseF L)"
    using freeIn.simps(6) by blast 
  then show ?thesis using g_def L_def by simp
qed



theorem freeIn_substNegInfinity : "freeIn var (substNegInfinity var A)"
  apply(cases A) using freeIn_altNegInf freeIn_allzero by simp_all


end

Theory NegInfinityUni

theory NegInfinityUni
  imports UniAtoms NegInfinity QE
begin

fun allZero' :: "real * real * real ⇒ atomUni fmUni" where
  "allZero' (a,b,c) = AndUni(AndUni(AtomUni(EqUni(0,0,a))) (AtomUni(EqUni(0,0,b)))) (AtomUni(EqUni(0,0,c)))"

lemma convert_allZero : 
  assumes "convert_poly var p (xs'@x#xs) = Some p'"
  assumes "length xs' = var"
  shows "eval (allZero p var) (xs'@x#xs) = evalUni (allZero' p') x"
proof(cases p')
  case (fields a b c)
  then show ?thesis proof(cases "MPoly_Type.degree p var = 0")
    case True
    then show ?thesis
      using assms fields
      by(simp add:eval_list_conj isovar_greater_degree)
  next
    case False
    then have nonzero : "MPoly_Type.degree p var ≠ 0" by auto
    then show ?thesis
    proof(cases "MPoly_Type.degree p var = 1")
      case True
      then show ?thesis
        using assms fields
        apply(simp add:eval_list_conj isovar_greater_degree)
        by (metis)
    next
      case False
      then have degree2 : "MPoly_Type.degree p var = 2" using degree_convert_eq[OF assms(1)] nonzero by auto
      then show ?thesis
        using assms
        apply(simp add:eval_list_conj isovar_greater_degree)
        using insertion_isovarspars_free list_update_code(2)
        apply auto
        by (metis One_nat_def Suc_1 less_2_cases less_Suc_eq numeral_3_eq_3)
    qed
  qed
qed



fun alternateNegInfinity' :: "real * real * real ⇒ atomUni fmUni" where
  "alternateNegInfinity' (a,b,c) = 
OrUni(AtomUni(LessUni(0,0,a)))(
AndUni(AtomUni(EqUni(0,0,a))) (
  OrUni(AtomUni(LessUni(0,0,-b)))(
  AndUni(AtomUni(EqUni(0,0,b)))(
    AtomUni(LessUni(0,0,c))
  ))
))
"

lemma convert_alternateNegInfinity : 
  assumes "convert_poly var p (xs'@x#xs) = Some X"
  assumes "length xs' = var"
  shows "eval (alternateNegInfinity p var) (xs'@x#xs) = evalUni (alternateNegInfinity' X) x"
proof(cases X)
  case (fields a b c)
  then show ?thesis proof(cases "MPoly_Type.degree p var = 0")
    case True
    then show ?thesis
      using assms
      apply (simp add: isovar_greater_degree)
      apply auto
      apply (metis aEval.simps(2) eval.simps(1) eval_and eval_false eval_or  mult_one_left)
      by (metis aEval.simps(2) eval.simps(1) eval_or  mult_one_left)
  next
    case False
    then have nonzero : "MPoly_Type.degree p var ≠ 0" by auto
    then show ?thesis
    proof(cases "MPoly_Type.degree p var = 1")
      case True
      have letbind: "eval
     (let a_n = isolate_variable_sparse p var (Suc 0)
      in or (fm.Atom (Less (Const (- 1) * a_n)))
          (and (fm.Atom (Eq a_n))
            (let a_n = isolate_variable_sparse p var 0
             in or (fm.Atom (Less (Const 1 * a_n))) (and (fm.Atom (Eq a_n)) FalseF))))
     (xs'@x#xs) = 
    eval
     (or (fm.Atom (Less (Const (- 1) * (isolate_variable_sparse p var (Suc 0)))))
          (and (fm.Atom (Eq (isolate_variable_sparse p var (Suc 0))))
            (or (fm.Atom (Less (Const 1 * (isolate_variable_sparse p var 0)))) (and (fm.Atom (Eq (isolate_variable_sparse p var 0))) FalseF))))
     (xs'@x#xs)"
        by meson 
      show ?thesis
        using assms True unfolding fields
        by (simp add: isovar_greater_degree letbind eval_or eval_and insertion_mult insertion_const)
    next
      case False
      then have degree2 : "MPoly_Type.degree p var = 2" using degree_convert_eq[OF assms(1)] nonzero by auto
      have "[0..<3] = [0,1,2]"
        by (simp add: upt_rec)
      then have unfold : " (foldl
       (λF i. let a_n = isolate_variable_sparse p var i
               in or (fm.Atom (Less ((if i mod 2 = 0 then Const 1 else Const (- 1)) * a_n)))
                   (and (fm.Atom (Eq a_n)) F))
       FalseF [0..<3]) =  
     (let a_n = isolate_variable_sparse p var 2
               in or (fm.Atom (Less ((Const 1) * a_n)))
                   (and (fm.Atom (Eq a_n))
       (let a_n = isolate_variable_sparse p var (Suc 0)
      in or (fm.Atom (Less (Const (- 1) * a_n)))
          (and (fm.Atom (Eq a_n))
            (let a_n = isolate_variable_sparse p var 0
             in or (fm.Atom (Less (Const 1 * a_n))) (and (fm.Atom (Eq a_n)) FalseF))))))" 
        by auto
      have letbind : "eval
     (foldl
       (λF i. let a_n = isolate_variable_sparse p var i
               in or (fm.Atom (Less ((if i mod 2 = 0 then Const 1 else Const (- 1)) * a_n)))
                   (and (fm.Atom (Eq a_n)) F))
       FalseF [0..<3]) (xs'@x#xs) = 
      eval
     
(or (fm.Atom (Less ( Const 1 * (isolate_variable_sparse p var 2))))
                   (and (fm.Atom (Eq (isolate_variable_sparse p var 2)))
(or (fm.Atom (Less (Const (- 1) * (isolate_variable_sparse p var (Suc 0)))))
          (and (fm.Atom (Eq (isolate_variable_sparse p var (Suc 0))))
            (or (fm.Atom (Less (Const 1 * (isolate_variable_sparse p var 0)))) (and (fm.Atom (Eq (isolate_variable_sparse p var 0))) FalseF))))))
(xs'@x#xs)" apply (simp add:unfold) by metis
      show ?thesis
        using degree2 assms unfolding fields by (simp add: isovar_greater_degree eval_or eval_and letbind insertion_mult insertion_const)
    qed
  qed
qed



fun substNegInfinityUni :: "atomUni ⇒ atomUni fmUni" where
  "substNegInfinityUni (EqUni p) = allZero' p " |
  "substNegInfinityUni (LessUni p) = alternateNegInfinity' p"|
  "substNegInfinityUni (LeqUni p) = OrUni (alternateNegInfinity' p) (allZero' p)"|
  "substNegInfinityUni (NeqUni p) = negUni (allZero' p)"


lemma convert_substNegInfinity : 
  assumes "convert_atom var A (xs'@x#xs) = Some(A')"
  assumes "length xs' = var"
  shows "eval (substNegInfinity var A) (xs'@x#xs) = evalUni (substNegInfinityUni A') x"
  using assms
proof(cases A)
  case (Less p)
  have "∃X. convert_poly var p (xs' @ x # xs) = Some X" using assms Less apply(cases "MPoly_Type.degree p var < 3") by (simp_all)
  then obtain X where X_def: "convert_poly var p (xs' @ x # xs) = Some X" by auto
  then have A' : "A' = LessUni X" using assms Less apply(cases "MPoly_Type.degree p var < 3") by (simp_all)
  show ?thesis unfolding Less substNegInfinity.simps
    unfolding convert_alternateNegInfinity[OF X_def assms(2)] A'
    apply(cases X) by simp
next
  case (Eq p)
  then show ?thesis using assms convert_allZero by auto
next
  case (Leq p)
  define p' where "p' = (case convert_poly var p (xs'@x#xs) of Some p' ⇒ p')"
  have A'_simp :  "A' = LeqUni p'"
    using assms Leq
    using p'_def by auto 
  have allZ : "eval (allZero p var) (xs'@x#xs) = evalUni (allZero' p') x" using convert_allZero
    using Leq assms p'_def by auto 
  have altNeg : "eval (alternateNegInfinity p var) (xs'@x#xs) = evalUni (alternateNegInfinity' p') x" using convert_alternateNegInfinity
    using Leq assms p'_def by auto
  show ?thesis
    unfolding Leq substNegInfinity.simps eval_Or A'_simp substNegInfinityUni.simps evalUni.simps
    using allZ altNeg by auto
next
  case (Neq p)
  then show ?thesis using assms convert_allZero convert_neg by auto
qed

lemma change_eval_eq:
  fixes x y:: "real"
  assumes "((aEvalUni (EqUni(a,b,c)) x ≠ aEvalUni (EqUni(a,b,c)) y) ∧ x < y)"
  shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
  using assms by auto
lemma change_eval_lt:
  fixes x y:: "real"
  assumes "((aEvalUni (LessUni (a,b,c)) x ≠ aEvalUni (LessUni (a,b,c)) y) ∧ x < y)"
  shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
proof - 
  let ?p = "[:c, b, a:]"
  have "sign ?p x ≠ sign ?p y"
    using assms unfolding sign_def 
    apply (simp add: distrib_left mult.commute mult.left_commute power2_eq_square)
    by linarith
  then have "(∃w ∈ (root_list ?p). x ≤ w ∧ w ≤ y)" using changes_sign 
      assms by auto
  then obtain w where w_prop: "w ∈ (root_list ?p) ∧ x ≤ w ∧ w ≤ y" by auto
  then have "a*w^2 + b*w + c = 0" unfolding root_list_def 
    using add.commute distrib_right mult.assoc mult.commute power2_eq_square
    using quadratic_poly_eval by force
  then show ?thesis using w_prop by auto
qed

lemma no_change_eval_lt:
  fixes x y:: "real"
  assumes "x < y"
  assumes "¬(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
  shows "((aEvalUni (LessUni (a,b,c)) x = aEvalUni (LessUni (a,b,c)) y))"
  using change_eval_lt
  using assms(1) assms(2) by blast 


lemma change_eval_neq:
  fixes x y:: "real"
  assumes "((aEvalUni (NeqUni (a,b,c)) x ≠ aEvalUni (NeqUni (a,b,c)) y) ∧ x < y)"
  shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
  using assms by auto 

lemma change_eval_leq:
  fixes x y:: "real"
  assumes "((aEvalUni (LeqUni (a,b,c)) x ≠ aEvalUni (LeqUni (a,b,c)) y) ∧ x < y)"
  shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
proof - 
  let ?p = "[:c, b, a:]"
  have "sign ?p x ≠ sign ?p y"
    using assms unfolding sign_def
    apply (simp add: distrib_left mult.commute mult.left_commute power2_eq_square)
    by linarith
  then have "(∃w ∈ (root_list ?p). x ≤ w ∧ w ≤ y)" using changes_sign 
      assms by auto
  then obtain w where w_prop: "w ∈ (root_list ?p) ∧ x ≤ w ∧ w ≤ y" by auto
  then have "a*w^2 + b*w + c = 0" unfolding root_list_def
    using add.commute distrib_right mult.assoc mult.commute power2_eq_square
    using quadratic_poly_eval by force  
  then show ?thesis using w_prop by auto
qed

lemma change_eval:
  fixes x y:: "real"
  fixes At:: "atomUni" 
  assumes xlt: "x < y"
  assumes noteq: "((aEvalUni At) x ≠ aEvalUni (At) y)"
  assumes "getPoly At = (a, b, c)"
  shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
proof - 
  have four_types: "At = (EqUni (a,b,c)) ∨ At = (LessUni (a,b,c)) ∨ At = (LeqUni (a,b,c)) ∨ At = (NeqUni (a,b,c))"
    using getPoly.elims assms(3) by force 
  have eq_h: "At = (EqUni (a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
    using assms(1) assms(2) change_eval_eq 
    by blast
  have less_h: "At = (LessUni(a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
    using change_eval_lt assms
    by blast
  have leq_h: "At = (LeqUni(a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
    using change_eval_leq assms
    by blast
  have neq_h: "At = (NeqUni(a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
    using change_eval_neq assms
    by blast
  show ?thesis
    using four_types eq_h less_h leq_h neq_h
    by blast 
qed 

lemma no_change_eval:
  fixes x y:: "real"
  assumes "getPoly At = (a, b, c)"
  assumes "x < y"
  assumes "¬(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)"
  shows  "((aEvalUni At) x = aEvalUni (At) y ∧ x < y)"
  using change_eval
  using assms(1) assms(2) assms(3) by blast 


lemma same_eval'' :
  assumes "getPoly At = (a, b, c)"
  assumes nonz: "a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0"
  shows "∃x. ∀y<x. (aEvalUni At y = aEvalUni At x)"
proof - 
  let ?p = "[:c, b, a:]"
  have poly_eval: "∀y. poly ?p y = a*y^2 + b*y + c" 
    by (simp add: distrib_left power2_eq_square) 
  have "?p ≠ 0" using nonz by auto
  then have "finite {y. poly ?p y = 0}"
    using poly_roots_finite
    by blast
  then have "finite {y. c + (a * y2 + b * y) = 0} ⟹
    ∀y. y * (b + y * a) = a * y2 + b * y ⟹
    finite {y. a * y2 + b * y + c = 0}"
  proof -
    assume a1: "finite {y. c + (a * y2 + b * y) = 0}"
    have "∀x0. c + (a * x02 + b * x0) = a * x02 + b * x0 + c"
      by simp
    then show ?thesis
      using a1 by presburger
  qed 
  then have finset: "finite {y. a*y^2 + b*y + c = 0}" 
    using poly_eval
    by (metis ‹finite {y. poly [:c, b, a:] y = 0}› poly_roots_set_same) 
  then have "∃x. (∀y. a*y^2 + b*y + c = 0 ⟶ x < y)" 
  proof - 
    let ?l = "sorted_list_of_set {y. a*y^2 + b*y + c = 0}"
    have "∃x. x < ?l ! 0" 
      using infzeros nonz by blast 
    then obtain x where x_prop: "x < ?l! 0" by auto
    then have "∀ y. List.member ?l y ⟶ x < y"
    proof clarsimp
      fix y
      assume "List.member ?l y"
      then have "∃n. n < length ?l ∧ ?l ! n = y"
        by (meson in_set_conv_nth in_set_member)
      then obtain n where n_prop: "n < length ?l ∧ ?l ! n = y"
        by auto
      have h: "∀n < length ?l. ?l ! n ≥ ?l !0" using sorted_iff_nth_mono
        using sorted_sorted_list_of_set by blast
      then have h: "y ≥ ?l ! 0" using n_prop by auto
      then show "x < y" using x_prop by auto
    qed
    then show ?thesis
      using finset set_sorted_list_of_set in_set_member
      by (metis (mono_tags, lifting) mem_Collect_eq)
  qed
  then obtain x where x_prop: "(∀y. a*y^2 + b*y + c = 0 ⟶ x < y)" by auto
  then have same_as: "∀y<x. (aEvalUni At y = aEvalUni At x)"
    using no_change_eval change_eval assms
  proof -
    have f1: "∀x0. (x0 < x) = (¬ 0 ≤ x0 + - 1 * x)"
      by auto
    have f2: "(0 ≤ - 1 * x + v0_0) = (x + - 1 * v0_0 ≤ 0)"
      by auto
    have f3: "v0_0 + - 1 * x = - 1 * x + v0_0"
      by auto
    have f4: "∀x0 x1 x2 x3. (x3::real) * x02 + x2 * x0 + x1 = x1 + x3 * x02 + x2 * x0"
      by auto
    have f5: "∀x3 x4 x5. (aEvalUni x3 x5 ≠ aEvalUni x3 x4) = ((¬ aEvalUni x3 x5) = aEvalUni x3 x4)"
      by fastforce
    have f6: "∀x0 x1 x2 x3 x4 x5. (x5 < x4 ∧ (¬ aEvalUni x3 x5) = aEvalUni x3 x4 ∧ getPoly x3 = (x2, x1, x0) ⟶ (∃v6≥x5. v6 ≤ x4 ∧ x0 + x2 * v62 + x1 * v6 = 0)) = ((¬ x5 < x4 ∨ (¬ aEvalUni x3 x5) ≠ aEvalUni x3 x4 ∨ getPoly x3 ≠ (x2, x1, x0)) ∨ (∃v6≥x5. v6 ≤ x4 ∧ x0 + x2 * v62 + x1 * v6 = 0))"
      by fastforce
    have f7: "∀x0 x5. ((x0::real) ≤ x5) = (x0 + - 1 * x5 ≤ 0)"
      by auto
    have f8: "∀x0 x6. ((x6::real) ≤ x0) = (0 ≤ x0 + - 1 * x6)"
      by auto
    have "∀x4 x5. ((x5::real) < x4) = (¬ x4 + - 1 * x5 ≤ 0)"
      by auto
    then have "(∀r ra a rb rc rd. r < ra ∧ aEvalUni a r ≠ aEvalUni a ra ∧ getPoly a = (rb, rc, rd) ⟶ (∃re≥r. re ≤ ra ∧ rb * re2 + rc * re + rd = 0)) = (∀r ra a rb rc rd. (ra + - 1 * r ≤ 0 ∨ (¬ aEvalUni a r) ≠ aEvalUni a ra ∨ getPoly a ≠ (rb, rc, rd)) ∨ (∃re. 0 ≤ re + - 1 * r ∧ re + - 1 * ra ≤ 0 ∧ rd + rb * re2 + rc * re = 0))"
      using f8 f7 f6 f5 f4 by presburger
    then have f9: "∀r ra a rb rc rd. (ra + - 1 * r ≤ 0 ∨ (¬ aEvalUni a r) ≠ aEvalUni a ra ∨ getPoly a ≠ (rb, rc, rd)) ∨ (∃re. 0 ≤ re + - 1 * r ∧ re + - 1 * ra ≤ 0 ∧ rd + rb * re2 + rc * re = 0)"
      by (meson change_eval)
    obtain rr :: "real ⇒ real ⇒ real ⇒ real ⇒ real ⇒ real" where
      "∀x0 x1 x2 x4 x5. (∃v6. 0 ≤ v6 + - 1 * x5 ∧ v6 + - 1 * x4 ≤ 0 ∧ x0 + x2 * v62 + x1 * v6 = 0) = (0 ≤ rr x0 x1 x2 x4 x5 + - 1 * x5 ∧ rr x0 x1 x2 x4 x5 + - 1 * x4 ≤ 0 ∧ x0 + x2 * (rr x0 x1 x2 x4 x5)2 + x1 * rr x0 x1 x2 x4 x5 = 0)"
      by moura
    then have f10: "∀r ra a rb rc rd. ra + - 1 * r ≤ 0 ∨ aEvalUni a r = aEvalUni a ra ∨ getPoly a ≠ (rb, rc, rd) ∨ r + - 1 * rr rd rc rb ra r ≤ 0 ∧ 0 ≤ ra + - 1 * rr rd rc rb ra r ∧ rd + rb * (rr rd rc rb ra r)2 + rc * rr rd rc rb ra r = 0"
      using f9 by simp
    have f11: "(rr c b a x v0_0 + - 1 * x ≤ 0) = (0 ≤ x + - 1 * rr c b a x v0_0)"
      by force
    have "∀x0. (x < x0) = (¬ x0 + - 1 * x ≤ 0)"
      by auto
    then have f12: "∀r. c + a * r2 + b * r ≠ 0 ∨ ¬ r + - 1 * x ≤ 0"
      using x_prop by auto
    obtain rra :: real where
      "(∃v0. ¬ 0 ≤ v0 + - 1 * x ∧ aEvalUni At v0 ≠ aEvalUni At x) = (¬ 0 ≤ rra + - 1 * x ∧ aEvalUni At rra ≠ aEvalUni At x)"
      by moura
    then show ?thesis
      using f12 f11 f10 f3 f2 f1
    proof -
      have f1: "∀x0. (x0 < x) = (¬ 0 ≤ x0 + - 1 * x)"
        by auto
      have f2: "(0 ≤ v0_0a + - 1 * x) = (x + - 1 * v0_0a ≤ 0)"
        by auto
      have f3: "(rr c b a x v0_0a + - 1 * x ≤ 0) = (0 ≤ x + - 1 * rr c b a x v0_0a)"
        by auto
      obtain rrb :: real where
        "(∃v0. ¬ 0 ≤ v0 + - 1 * x ∧ aEvalUni At v0 ≠ aEvalUni At x) = (¬ 0 ≤ rrb + - 1 * x ∧ aEvalUni At rrb ≠ aEvalUni At x)"
        by blast
      then show ?thesis
        using f3 f2 f1 assms(1) f10 f12
        by smt
    qed
  qed
  then show ?thesis by auto
qed


lemma inequality_case : "(∃(x::real). ∀(y::real)<x. (a::real) * y2 + (b::real) * y + (c::real) < 0) =
    (a < 0 ∨ a = 0 ∧ (0 < b ∨ b = 0 ∧ c < 0))"
proof-
  let ?At = "(LessUni (a, b, c))"
  have firsth : "⋀x. (∀y<x. a * y2 + b * y + c < 0 ⟹ a≤0)"
  proof -
    fix x
    assume lt: "∀y<x. a * y2 + b * y + c < 0"
    have "∃w. ∀y < w. y^2 > (-b/a)*y - c/a"  using ysq_dom_y_plus_coeff[where b = "-b/a", where c = "-c/a"]
      by auto   
    then have gtdomhelp: "a > 0 ⟹ ∃w. ∀y < w. a*y^2 > a*((-b/a)*y - c/a)"
      by auto
    have "∀y. (a > 0 ⟶ a*((-b/a)*y - c/a) = -b*y - c)"
      by (simp add: right_diff_distrib') 
    then have gtdom: "a > 0 ⟹ ∃w.∀y < w. a*y^2 > -b*y - c"
      using gtdomhelp
      by simp 
    then have " a > 0 ⟹ False"
    proof - 
      assume "a > 0"
      then have "∃w.∀y < w. a*y^2 > -b*y - c" using gtdom by auto
      then obtain w where w_prop: "∀y < w. a*y^2 + b*y + c > 0"
        by fastforce 
      let ?mn = "min w x - 1"
      have gtz: "a*?mn^2 + b*?mn + c > 0" using w_prop
        by auto
      have ltz: "a*?mn^2 + b*?mn + c < 0" using lt by auto
      then show "False" using gtz ltz by auto
    qed
    then show "a ≤ 0"
      by fastforce 
  qed
  have bleq0 : "⋀x. (∀y<x. b * y + c < 0 ⟹ b≥0)"
  proof -
    fix x
    assume lt: "∀y<x. b * y + c < 0"
    have gtdom: "b < 0 ⟹ ∃w.∀y < w. b*y > - c"
      by (metis mult.commute neg_less_divide_eq)
    then have "b < 0 ⟹ False"
    proof - 
      assume "b < 0"
      then have "∃w.∀y < w. b*y > - c" using gtdom by auto
      then obtain w where w_prop: "∀y < w .b*y + c > 0"
        by fastforce 
      let ?mn = "min w x - 1"
      have gtz: "b*?mn + c > 0" using w_prop
        by auto
      have ltz: "b*?mn + c < 0" using lt by auto
      then show "False" using gtz ltz by auto
    qed
    then show "b ≥ 0"
      by fastforce 
  qed
  have secondh: "⋀x. (∀y<x. a * y2 + b * y + c < 0 ⟹ ¬ a < 0 ⟹ ¬ 0 < b ⟹ b = 0)"
    using firsth bleq0
    by (metis add.commute add.right_neutral less_eq_real_def mult_zero_class.mult_zero_left) 
  have thirdh : "⋀x. ∀y<x. a * y2 + b * y + c < 0 ⟹ ¬ a < 0 ⟹ ¬ 0 < b ⟹ c < 0"
    using firsth secondh add.commute add.right_neutral infzeros mult_zero_class.mult_zero_left not_numeral_le_zero order_refl
    by (metis less_eq_real_def)
  have fourthh : "a < 0 ⟹ ∃x. ∀y<x. a * y2 + b * y + c < 0"
  proof - 
    assume aleq: "a < 0"
    have "∃(w::real). ∀(y::real). (y < w ⟶ y^2 > (-b/a)*y + (-c/a))"
      using ysq_dom_y_plus_coeff[where b = "-b/a", where c = "-c/a"]
      by blast 
    then have hyp:"∃(w::real). ∀(y::real). (y < w ⟶ a*y^2 ≤ a*(-b/a)*y + a*(-c/a))"
      by (metis (no_types, hide_lams) ‹a < 0› distrib_left less_eq_real_def linorder_not_le mult.assoc mult_less_cancel_left)
    have "∀y. a*(-b/a)*y + a*(-c/a) = -b*y -c"
      using ‹a < 0› by auto
    then have "∃(w::real). ∀(y::real). (y < w ⟶ a*y^2 ≤ -b*y - c)"
      using hyp by auto
    then have "∃(w::real). ∀(y::real). (y < w ⟶ a*y^2 + b*y + c ≤ 0)"
      by (metis add.commute add_uminus_conv_diff le_diff_eq mult_minus_left real_add_le_0_iff)
    then obtain w where w_prop: "∀(y::real). (y < w ⟶ a*y^2 + b*y + c ≤ 0)" by auto
    have "∃x. ∀y < x. aEvalUni ?At x = aEvalUni ?At y" using same_eval''
    proof -
      have f1: "∀x0 x1. ((x0::real) < x1) = (¬ 0 ≤ x0 + - 1 * x1)"
        by linarith
      have "a ≠ 0"
        using ‹a < 0› by force
      then obtain rr :: "atomUni ⇒ real" where
        "∀r. 0 ≤ r + - 1 * rr (LessUni (a, b, c)) ∨ aEvalUni (LessUni (a, b, c)) r = aEvalUni (LessUni (a, b, c)) (rr (LessUni (a, b, c)))"
        using f1 by (metis getPoly.simps(4) same_eval'')
      then show ?thesis
        using f1 by meson
    qed
    then obtain x where x_prop: "∀y < x. aEvalUni ?At x = aEvalUni ?At y" by auto
    let ?mn = "min x w - 1"
    have "∀y < ?mn.  aEvalUni ?At y = True ∨ aEvalUni ?At y = False"
      using x_prop by auto
    have "∀ y < ?mn. aEvalUni ?At y = False ⟶ a*y^2 + b*y + c ≥ 0"
      by auto
    then have "⋀y. ∀y<w. a * y2 + b * y + c ≤ 0 ⟹
         y < min x w - 1 ⟹
         ¬ a * y2 + b * y + c < 0 ⟹
         a * y2 + b * y + c = 0"
    proof -
      fix y :: real
      assume a1: "y < min x w - 1"
      assume a2: "¬ a * y2 + b * y + c < 0"
      assume a3: "∀y<w. a * y2 + b * y + c ≤ 0"
      have "y < w"
        using a1 by linarith
      then show "a * y2 + b * y + c = 0"
        using a3 a2 less_eq_real_def by blast
    qed 
    then have "∀ y < ?mn. aEvalUni ?At y = False ⟶ a*y^2 + b*y + c = 0"
      using w_prop by auto    
    then have "∀ y < ?mn. aEvalUni ?At y = False ⟹ False" using infzeros aleq
      by (metis power_zero_numeral zero_less_power2)
    then have "∀ y < ?mn. aEvalUni ?At y = True"
    proof -
      { fix rr :: real
        have "∀r ra. (ra::real) < r ∨ ¬ ra < r + - 1"
          by linarith
        then have "¬ rr < min x w - 1 ∨ aEvalUni (LessUni (a, b, c)) rr"
          by (metis (no_types) ‹∀y<min x w - 1. aEvalUni (LessUni (a, b, c)) y = False ⟹ False› ab_group_add_class.ab_diff_conv_add_uminus less_eq_real_def min_less_iff_disj not_le x_prop) }
      then show ?thesis
        by blast
    qed 
    then show ?thesis by auto
  qed
  have fifthh : "b > 0 ⟹ ∃x. ∀y<x. b * y + c < 0"
  proof-
    assume bh : "b > 0"
    show "∃x. ∀y<x. b * y + c < 0"
      apply(rule exI[where x="-c/b"])
      apply auto
      using bh
      by (simp add: mult.commute pos_less_minus_divide_eq) 
  qed
  show ?thesis
    apply(auto)
    using firsth apply simp
    using secondh apply simp 
    using thirdh apply simp
    using fourthh apply simp
    using fifthh by simp
qed

lemma inequality_case_geq : "(∃(x::real). ∀(y::real)<x. (a::real) * y2 + (b::real) * y + (c::real) > 0) =
    (a > 0 ∨ a = 0 ∧ (0 > b ∨ b = 0 ∧ c > 0))"
proof - 
  have s1: "∀y. - 1 * a * y2 + - 1 * b * y + - 1 * c < 0 ⟷  a * y2 +  b * y +  c > 0"
    by auto
  have s2: "(- 1 * a < 0 ∨ - 1 * a = 0 ∧ (0 < - 1 * b ∨ - 1 * b = 0 ∧ - 1 * c < 0)) ⟷
   (a > 0 ∨ a = 0 ∧ (0 > b ∨  b = 0 ∧ c > 0))  "
    by auto
  have "(∃x. ∀y<x. - 1 * a * y2 + - 1 * b * y + - 1 * c < 0) =
  (- 1 * a < 0 ∨ - 1 * a = 0 ∧ (0 < - 1 * b ∨ - 1 * b = 0 ∧ - 1 * c < 0))"
    using inequality_case[where a = "-1*a", where b = "-1*b", where c= "-1*c"]
    by auto
  then show ?thesis
    using s1 s2 by auto
qed

lemma infinity_evalUni_LessUni : "(∃x. ∀y<x. aEvalUni (LessUni p) y) = (evalUni (substNegInfinityUni (LessUni p)) x)"
proof(cases p)
  case (fields a b c)
  show ?thesis 
    unfolding fields  apply simp
    using inequality_case[of a b c] .
qed

lemma infinity_evalUni_EqUni : "(∃x. ∀y<x. aEvalUni (EqUni p) y) = (evalUni (substNegInfinityUni (EqUni p)) x)"
proof(cases p)
  case (fields a b c)
  show ?thesis
    using infzeros[of _ a b c] by(auto simp add: fields)
qed

lemma infinity_evalUni_NeqUni : "(∃x. ∀y<x. aEvalUni (NeqUni p) y) = (evalUni (substNegInfinityUni (NeqUni p)) x)"
proof(cases p)
  case (fields a b c)
  show ?thesis
    unfolding fields  apply simp 
    using inequality_case[of a b c] 
    using inequality_case_geq[of a b c]
    by (metis less_numeral_extra(3) linorder_neqE_linordered_idom mult_eq_0_iff)

qed

lemma infinity_evalUni_LeqUni : "(∃x. ∀y<x. aEvalUni (LeqUni p) y) = (evalUni (substNegInfinityUni (LeqUni p)) x)"
proof(cases p)
  case (fields a b c)
  show ?thesis
    unfolding fields  apply simp 
  proof -
    have h1: "((∃x. ∀y<x. a * y2 + b * y + c < 0) ∨ (∃x. ∀y<x. a * y2 + b * y + c = 0)) ⟶ (∃x. ∀y<x. a * y2 + b * y + c ≤ 0)"
      using less_eq_real_def
      by auto
    have h2: "(∃x. ∀y<x. a * y2 + b * y + c ≤ 0) ⟹ ((∃x. ∀y<x. a * y2 + b * y + c < 0) ∨ (∃x. ∀y<x. a * y2 + b * y + c = 0))"
    proof -
      assume a1: "(∃x. ∀y<x. a * y2 + b * y + c ≤ 0)"
      have "¬(∃x. ∀y<x. a * y2 + b * y + c = 0) ⟹ (∃x. ∀y<x. a * y2 + b * y + c < 0) " 
      proof - 
        assume a2: "¬(∃x. ∀y<x. a * y2 + b * y + c = 0)"
        then have "a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0" by auto
        then have "(a < 0 ∨ a = 0 ∧ (0 < b ∨ b = 0 ∧ c < 0))"
        proof - 
          have x1: "a > 0 ⟹ False"
          proof - 
            assume "a > 0"
            then have "(∃(x::real). ∀(y::real)<x. (a::real) * y2 + (b::real) * y + (c::real) > 0)" using inequality_case_geq
              by auto
            then  show ?thesis
              using a1 
              by (meson a2 linorder_not_le min_less_iff_conj)  
          qed
          then have x2: "a = 0 ∧ 0 > b ⟹ False"
          proof - 
            assume "a = 0 ∧ 0 > b"
            then have "(∃(x::real). ∀(y::real)<x. (a::real) * y2 + (b::real) * y + (c::real) > 0)" using inequality_case_geq
              by blast
            then show ?thesis
              using a1
              by (meson a2 linorder_not_le min_less_iff_conj) 
          qed
          then have x3: "a = 0 ∧ b = 0 ∧ c > 0 ⟹ False "
            using a1 a2 by auto  
          show ?thesis using x1 x2 x3
            by (meson ‹a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0› linorder_neqE_linordered_idom) 
        qed
        then show "(∃x. ∀y<x. a * y2 + b * y + c < 0)" using inequality_case
          by auto
      qed
      then show ?thesis
        by auto
    qed
    have "(∃x. ∀y<x. a * y2 + b * y + c ≤ 0) = (∃x. ∀y<x. a * y2 + b * y + c < 0) ∨ (∃x. ∀y<x. a * y2 + b * y + c = 0)"
      using h1 h2 by auto
    then show "(∃x. ∀y<x. a * y2 + b * y + c ≤ 0) =
    (a < 0 ∨ a = 0 ∧ (0 < b ∨ b = 0 ∧ c < 0) ∨ a = 0 ∧ b = 0 ∧ c = 0)"
      using inequality_case[of a b c] infzeros[of _ a b c] by auto
  qed
qed

text "This is the vertical translation for substNegInfinityUni where we represent the virtual
substution of negative infinity in the univariate case"
lemma infinity_evalUni :
  shows "(∃x. ∀y<x. aEvalUni At y) = (evalUni (substNegInfinityUni At) x)"
proof(cases At)
  case (LessUni p)
  then show ?thesis using infinity_evalUni_LessUni by auto
next
  case (EqUni p)
  then show ?thesis using infinity_evalUni_EqUni by auto
next
  case (LeqUni p)
  then show ?thesis using infinity_evalUni_LeqUni by auto
next
  case (NeqUni p)
  then show ?thesis using infinity_evalUni_NeqUni by auto
qed

end

Theory Infinitesimals

subsection "Infinitesimals"
theory Infinitesimals
  imports ExecutiblePolyProps LinearCase QuadraticCase NegInfinity Debruijn
begin

lemma freeIn_substInfinitesimalQuadratic :
  assumes "var ∉ vars a"
    "var ∉ vars b"
    "var ∉ vars c"
    "var ∉ vars d"
  shows "freeIn var (substInfinitesimalQuadratic var a b c d At)"
proof(cases At)
  case (Less p)
  show ?thesis unfolding substInfinitesimalQuadratic.simps Less
    apply(rule free_in_quad_fm[of var a b c d "(convertDerivative var p)"])
    using assms by auto
next
  case (Eq p)
  then show ?thesis apply simp
    apply(rule freeIn_list_conj)
    apply auto
    using not_in_isovarspar by simp_all
next
  case (Leq p)
  then show ?thesis unfolding substInfinitesimalQuadratic.simps Leq freeIn.simps
    using free_in_quad_fm[of var a b c d "(convertDerivative var p)", OF assms] apply simp
    apply(rule freeIn_list_conj)
    using not_in_isovarspar by simp_all
next
  case (Neq p)
  then show ?thesis apply (auto simp add:neg_def)
    apply(rule freeIn_list_conj)
    apply auto
    using not_in_isovarspar by simp_all
qed

lemma freeIn_substInfinitesimalQuadratic_fm : assumes "var ∉ vars a"
  "var ∉ vars b"
  "var ∉ vars c"
  "var ∉ vars d"
shows"freeIn var (substInfinitesimalQuadratic_fm var a b c d F)"
proof-
  {fix z
    have "freeIn (var+z)
     (liftmap
       (λx. substInfinitesimalQuadratic (var + x) (liftPoly 0 x a) (liftPoly 0 x b)
              (liftPoly 0 x c) (liftPoly 0 x d))
       F z)"
      apply(induction F arbitrary:z) apply auto
          apply(rule freeIn_substInfinitesimalQuadratic)
             apply (simp_all add: assms not_in_lift)
         apply (metis (no_types, lifting) add_Suc_right)
        apply (metis (mono_tags, lifting) add_Suc_right)
       apply (simp add: ab_semigroup_add_class.add_ac(1))
      by (simp add: add.assoc)
  }then show ?thesis 
    unfolding substInfinitesimalQuadratic_fm.simps
    by (metis (no_types, lifting) add.right_neutral) 
qed

lemma freeIn_substInfinitesimalLinear:
  assumes "var ∉ vars a" "var ∉ vars b"
  shows "freeIn var (substInfinitesimalLinear var a b At)"
proof(cases At)
  case (Less p)
  show ?thesis unfolding Less substInfinitesimalLinear.simps
    using var_not_in_linear_fm[of var a b "(convertDerivative var p)", OF assms]
    unfolding linear_substitution_fm.simps linear_substitution_fm_helper.simps .
next
  case (Eq p)
  then show ?thesis apply simp apply(rule freeIn_list_conj)
    apply auto
    using not_in_isovarspar by simp_all
next
  case (Leq p)
  show ?thesis unfolding Leq substInfinitesimalLinear.simps freeIn.simps
    using var_not_in_linear_fm[of var a b "(convertDerivative var p)", OF assms]
    unfolding linear_substitution_fm.simps linear_substitution_fm_helper.simps apply simp apply(rule freeIn_list_conj)
    apply auto
    using not_in_isovarspar by simp_all
next
  case (Neq p)
  then show ?thesis apply (auto simp add:neg_def) apply(rule freeIn_list_conj)
    apply auto
    using not_in_isovarspar by simp_all
qed

lemma freeIn_substInfinitesimalLinear_fm:
  assumes "var ∉ vars a" "var ∉ vars b"
  shows "freeIn var (substInfinitesimalLinear_fm var a b F)"
proof-
  {fix z
    have "freeIn (var+z)
     (liftmap (λx. substInfinitesimalLinear (var + x) (liftPoly 0 x a) (liftPoly 0 x b)) F z)"
      apply(induction F arbitrary:z) apply auto
      apply(rule freeIn_substInfinitesimalLinear)
      apply (simp_all add: assms not_in_lift)
      apply (metis (full_types) Suc_eq_plus1 ab_semigroup_add_class.add_ac(1))
      apply (metis (full_types) Suc_eq_plus1 ab_semigroup_add_class.add_ac(1))
      apply (simp add: add.assoc)
      by (simp add: add.assoc)
  }
  then show ?thesis
    unfolding substInfinitesimalLinear_fm.simps
    by (metis (no_types, lifting) add.right_neutral)
qed

end

Theory InfinitesimalsUni

theory InfinitesimalsUni
  imports Infinitesimals UniAtoms NegInfinityUni QE

begin



fun convertDerivativeUni ::  "real * real * real ⇒ atomUni fmUni" where
  "convertDerivativeUni (a,b,c) = 
  OrUni(AtomUni(LessUni(a,b,c)))(AndUni(AtomUni(EqUni(a,b,c)))(
    OrUni(AtomUni(LessUni(0,2*a,b)))(AndUni(AtomUni(EqUni(0,2*a,b)))(
      (AtomUni(LessUni(0,0,2*a)))
    ))
  ))
"



lemma convert_convertDerivative : 
  assumes "convert_poly var p (xs'@x#xs) = Some(a,b,c)"
  assumes "length xs' = var"
  shows "eval (convertDerivative var p) (xs'@x#xs) = evalUni (convertDerivativeUni (a,b,c)) x"
proof(cases "MPoly_Type.degree p var = 0")
  case True
  then show ?thesis using assms apply (simp add: isovar_greater_degree eval_or eval_and insertion_mult insertion_const)
    using sum_over_zero[of p var] by auto
next
  case False
  then have nonzero: "MPoly_Type.degree p var ≠ 0" by auto
  then show ?thesis proof(cases "MPoly_Type.degree p var = 1")
    case True
    have h1 : "MPoly_Type.degree p var < 3" using True by auto
    have h2 : "get_coeffs var p = (isolate_variable_sparse p var 2, isolate_variable_sparse p var 1, isolate_variable_sparse p var 0)" by auto
    have h : "insertion (nth_default 0 (xs' @ x # xs)) p = b * x + c"
      using poly_to_univar[OF h1 h2 _ _ _ assms(2), of  a x xs b c x] using assms(1) apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      using isovar_greater_degree[of p var] unfolding True by simp
    have h3: "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1) var = 0"
      using degree_mult[of "isolate_variable_sparse p var (Suc 0)" "Const 1" var]
      using degree_isovarspar mult_one_right by presburger
    show ?thesis
      using assms True
      unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "(derivative var p)"]
      apply (simp add: derivative_def isovar_greater_degree eval_or eval_and insertion_add insertion_mult insertion_const HOL.arg_cong[OF sum_over_zero[of p var], of "insertion (nth_default var (xs'@x#xs))"] insertion_var_zero del:convertDerivative.simps)    
      unfolding h     h3 by(simp del:convertDerivative.simps)
  next
    case False
    then have deg2 :  "MPoly_Type.degree p var = 2"
      by (metis One_nat_def assms(1) convert_poly.simps le_SucE less_Suc0 less_Suc_eq_le nonzero numeral_2_eq_2 numeral_3_eq_3 option.distinct(1)) 
    then have first : "isolate_variable_sparse p var (Suc (Suc 0)) ≠ 0"
      by (metis MPoly_Type.degree_zero isolate_variable_sparse_degree_eq_zero_iff nat.distinct(1) numeral_2_eq_2)
    have second : "(isolate_variable_sparse p var (Suc (Suc 0)) * Var var)≠0"
      by (metis MPoly_Type.degree_zero One_nat_def ExecutiblePolyProps.degree_one Zero_not_Suc first mult_eq_0_iff)
    have other : "Const (2::real)≠0"
      by (simp add: nonzero_const_is_nonzero)
    have thing: "(Var var::real mpoly) ≠ 0"
      using second by auto 
    have degree: "MPoly_Type.degree
                  (isolate_variable_sparse p var (Suc 0) * Const 1 +
                   isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
                  var -
                 Suc 0 = 0"
      apply simp apply(rule Nat.eq_imp_le) apply(rule degree_less_sum'[of _ _ 0])
      apply (simp add: degree_isovarspar mult_one_right)  apply auto
      unfolding degree_mult[OF second other, of var] degree_const apply simp
      unfolding degree_mult[OF first thing] degree_one
      using degree_isovarspar by force
    have insertion: "insertion (nth_default 0 (xs'@x#xs)) (∑(i::nat)≤2. isolate_variable_sparse p var i * Var var ^ i) = a * x^2 + b * x + c"
    proof(cases "MPoly_Type.degree p var = 1")
      case True
      then show ?thesis
        using False by blast
    next
      case False
      then have deg2 :  "MPoly_Type.degree p var = 2"
        by (metis One_nat_def assms(1) convert_poly.simps le_SucE less_Suc0 less_Suc_eq_le nonzero numeral_2_eq_2 numeral_3_eq_3 option.distinct(1)) 
      then have degless3 : "MPoly_Type.degree p var < 3" by auto
      have thing : "var<length(xs'@x # xs)" using assms by auto
      have h : "(∑i≤2. isolate_variable_sparse p var i * Var var ^ i) = p"
        using deg2
        by (metis sum_over_zero)
      have three: "(3::nat) = Suc(Suc(Suc(0)))" by auto
      have "(∑i = 0..<3. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var i) * x ^ i) =
          (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) * x ^ 0) + 
          (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (1::nat)) * x ^ (1::nat)) + 
          (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (2::nat)) * x ^ (2::nat))"
        unfolding Set_Interval.comm_monoid_add_class.sum.atLeast0_lessThan_Suc three
      proof -
        have "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (MPoly_Type.degree p var)) * x ^ MPoly_Type.degree p var + (x * insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) + (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) + (∑n = 0..<0. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var n) * x ^ n))) = insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) + x * insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (MPoly_Type.degree p var)) * x ^ MPoly_Type.degree p var"
          by auto
        then show "(∑n = 0..<0. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var n) * x ^ n) + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) * x ^ 0 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) * x ^ Suc 0 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc (Suc 0))) * x ^ Suc (Suc 0) = insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) * x ^ 0 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) * x ^ 1 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 2) * x2"
          by (metis (no_types) One_nat_def Suc_1 add.commute deg2 mult.commute mult.left_neutral power_0 power_one_right)
      qed
      also have "... =  a * x2 + b * x + c"
        unfolding Power.power_class.power.power_0 Power.monoid_mult_class.power_one_right Groups.monoid_mult_class.mult_1_right
        using assms unfolding convert_poly.simps using degless3 by simp
      finally have h2  :"(∑i = 0..<3. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var i) * x ^ i) =  a * x2 + b * x + c "
        .
      show ?thesis using sum_over_degree_insertion[OF thing deg2, of x] apply auto  using h h2 using assms(2) by auto
    qed
    have insertionb: "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) = b"
      using assms apply(cases "MPoly_Type.degree p var < 3") by simp_all
    have insertiona : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc (Suc 0))) = a" 
      using assms apply(cases "MPoly_Type.degree p var < 3")  apply simp_all
      by (simp add: numeral_2_eq_2)
    have x :  "insertion (nth_default 0 (xs' @ x # xs)) (Var var) = x" using insertion_var[of var "(xs' @ x # xs)" x] using assms(2) by auto
    have zero1 : "insertion (nth_default 0 (xs' @ x # xs))
     (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var (Suc 0)) = 0"
      by (simp add: degree_isovarspar isovar_greater_degree)
    have zero2 : "insertion (nth_default 0 (xs' @ x # xs))
      (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var 0) = a"
      using degree0isovarspar degree_isovarspar insertiona by presburger
    have zero3 : "insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse (Var var) var (Suc 0)) = 1" using isolate_var_one
      using MPoly_Type.insertion_one by fastforce
    have zero4 : "insertion (nth_default 0 (xs' @ x # xs))
      (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var (Suc 0)) = 0"
      by (simp add: degree_isovarspar isovar_greater_degree)
    have insertion_deriv : "insertion (nth_default 0 (xs'@x#xs))
       (isolate_variable_sparse
         (isolate_variable_sparse p var (Suc 0) * Const 1 +
          isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
         var (Suc 0)) = 2*a" 
      unfolding isovarspar_sum isolate_variable_sparse_mult apply auto
      unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right
        Groups.group_add_class.add.group_left_neutral
      unfolding insertion_add insertion_mult insertion_const apply auto
      unfolding zero1 zero2 zero3 zero4 by simp
    have deg2 : "MPoly_Type.degree p var = 2" using degree_convert_eq[OF assms(1)] False nonzero by auto
    then show ?thesis
      using assms 
      unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "(derivative var p)"] convertDerivative.simps[of _ "(derivative var (derivative var p))"]
      apply (simp add: x insertionb insertiona insertion_deriv insertion degree derivative_def isovar_greater_degree eval_or eval_and insertion_add insertion_mult insertion_const HOL.arg_cong[OF sum_over_zero[of p var], of "insertion (nth_default 0 (xs'@x#xs))"] insertion_var_zero del:convertDerivative.simps)
      by (smt (z3) One_nat_def degree_isovarspar distrib_right insertion_deriv isolate_variable_sparse_ne_zeroD mult_one_right neq0_conv not_one_le_zero zero1)
  qed
qed

fun linearSubstitutionUni :: "real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where
  "linearSubstitutionUni b c a = (if aEvalUni a (-c/b) then TrueFUni else FalseFUni)"

lemma convert_linearSubstitutionUni: 
  assumes "convert_atom var a (xs'@x#xs) = Some(a')"
  assumes "insertion (nth_default 0 (xs'@x#xs)) b = B"
  assumes "insertion (nth_default 0 (xs'@x#xs)) c = C"
  assumes "B ≠ 0"
  assumes "var∉(vars b)"
  assumes "var∉(vars c)"
  assumes "length xs' = var"
  shows "aEval (linear_substitution var (-c) b a) (xs'@x#xs) = evalUni (linearSubstitutionUni B C a') x"
  using assms
proof -
  have "aEval a (xs'@(-C/B)#xs) = evalUni (linearSubstitutionUni B C a') x"
    using assms(1) proof(cases "a")
    case (Less p)
    then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto
    then show ?thesis
      using Less assms apply simp
      using poly_to_univar by force
  next
    case (Eq p)
    then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto
    then show ?thesis
      using Eq assms apply simp
      using poly_to_univar by force
  next
    case (Leq p)
    then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto
    then show ?thesis
      using Leq assms apply simp
      using poly_to_univar by force
  next
    case (Neq p)
    then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto
    then show ?thesis
      using Neq assms apply simp
      using poly_to_univar by force
  qed
  then have subst : "aEval a ((xs'@x#xs)[var := - C / B]) = evalUni (linearSubstitutionUni B C a') x" using assms by auto
  have hlength : "var< length (xs'@x#xs)" using assms by auto
  have inB : "insertion (nth_default 0 ((xs'@x#xs)[var := - C / B])) b = B" using assms apply auto apply(cases a) apply auto
    by (simp add: insertion_lowerPoly1)+ 
  have inC : "insertion (nth_default 0 ((xs'@x#xs)[var := - C / B])) (-c) = -C" using assms apply auto apply(cases a) apply auto
    by (simp add: insertion_lowerPoly1 insertion_neg)+
  have freenegc : "var∉vars(-c)" using assms not_in_neg by auto
  show ?thesis using linear[OF hlength assms(4)  freenegc assms(5) inC inB, of a ] subst
    using  var_not_in_eval3[OF var_not_in_linear[OF freenegc assms(5)] assms(7)]
    by (metis assms(7) list_update_length)
qed
  (*
  substInfinitesimalLinear var b c A
  substitutes -c/b+epsilon for variable var in atom A
  assumes b is nonzero
  defined in page 615
*)
fun substInfinitesimalLinearUni :: "real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where
  "substInfinitesimalLinearUni b c (EqUni p) = allZero' p"|
  "substInfinitesimalLinearUni b c (LessUni p) = 
  map_atomUni (linearSubstitutionUni b c) (convertDerivativeUni p)"|
  "substInfinitesimalLinearUni b c (LeqUni p) = 
OrUni
  (allZero' p)
  (map_atomUni (linearSubstitutionUni b c) (convertDerivativeUni p))"|
  "substInfinitesimalLinearUni b c (NeqUni p) = negUni (allZero' p)"


lemma convert_linear_subst_fm :
  assumes "convert_atom var a (xs'@x#xs) = Some a'"
  assumes "insertion (nth_default 0 (xs'@x#xs)) b = B"
  assumes "insertion (nth_default 0 (xs'@x#xs)) c = C"
  assumes "B ≠ 0"
  assumes "var∉(vars b)"
  assumes "var∉(vars c)"
  assumes "length xs' = var"
  shows "aEval (linear_substitution (var + 0) (liftPoly 0 0 (-c)) (liftPoly 0 0 b) a) (xs'@x#xs) =
     evalUni (linearSubstitutionUni B C a') x"
proof-
  have lb : "insertion (nth_default 0 (xs'@x#xs)) (liftPoly 0 0 b) = B" unfolding lift00 using assms(2) by auto
  have lc : "insertion (nth_default 0 (xs'@x#xs)) (liftPoly 0 0 c) = C" unfolding lift00 using assms(3) insertion_neg by auto
  have nb : "var ∉ vars (liftPoly 0 0 b)" using not_in_lift[OF assms(5), of 0] by auto
  have nc : "var ∉ vars (liftPoly 0 0 c)" using not_in_lift[OF assms(6)] not_in_neg
    using assms(6) lift00 by auto
  then show ?thesis using assms using lb lc convert_linearSubstitutionUni[OF assms(1)  lb lc assms(4) nb nc]
    by (simp add: lift00)
qed

lemma evalUni_if : "evalUni (if cond then TrueFUni else FalseFUni) x = cond"
  by(cases cond)(auto)

lemma degree_less_sum' : "MPoly_Type.degree (p::real mpoly) var = n ⟹ MPoly_Type.degree (q::real mpoly) var = m ⟹ n < m ⟹ MPoly_Type.degree (p + q) var = m"
  using degree_less_sum[of q var m p n]
  by (simp add: add.commute) 

lemma convert_substInfinitesimalLinear_less : 
  assumes "convert_poly var p (xs'@x#xs) = Some(p')"
  assumes "insertion (nth_default 0 (xs'@x#xs)) b = B"
  assumes "insertion (nth_default 0 (xs'@x#xs)) c = C"
  assumes "B ≠ 0"
  assumes "var∉(vars b)"
  assumes "var∉(vars c)"
  assumes "length xs' = var"
  shows "
eval (liftmap
    (λx. λA. Atom(linear_substitution (var+x) (liftPoly 0 x (-c)) (liftPoly 0 x b) A)) 
    (convertDerivative var p)
    0) (xs'@x#xs) =
evalUni (map_atomUni (linearSubstitutionUni B C) (convertDerivativeUni p')) x"
proof(cases p')
  case (fields a' b' c')
  have h : "convert_poly var p (xs'@x#xs) = Some (a', b', c')"
    using assms fields by auto
  have h2 : "∃F'. convert_fm var (convertDerivative var p) xs = Some F'"
    unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "derivative var p"] convertDerivative.simps[of _ "derivative var (derivative var p)"]
    apply( auto simp del: convertDerivative.simps)
    using degree_convert_eq h apply blast
    using assms(1) degree_convert_eq apply blast
    apply (metis Suc_eq_plus1 degree_derivative gr_implies_not0 less_trans_Suc nat_neq_iff)
    using assms(1) degree_convert_eq apply blast
    apply (meson assms(1) degree_convert_eq)
    apply (metis One_nat_def Suc_eq_plus1 degree_derivative less_2_cases less_Suc_eq nat_neq_iff numeral_3_eq_3 one_add_one)
    using assms(1) degree_convert_eq apply blast
    using degree_derivative apply force
    using assms(1) degree_convert_eq apply blast
    apply (meson assms(1) degree_convert_eq)
    apply (metis degree_derivative eq_numeral_Suc less_add_one less_trans_Suc not_less_eq numeral_2_eq_2 pred_numeral_simps(3))
    apply (meson assms(1) degree_convert_eq)
    using degree_derivative apply fastforce
    by (meson assms(1) degree_convert_eq)
  have c'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) = c'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto
  have b'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) = b'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto
  then have b'_insertion2 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) = b'"
    by auto
  have a'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 2) = a'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto
  have liftb : "liftPoly 0 0 b = b" using lift00 by auto
  have liftc : "liftPoly 0 0 c = c" using lift00 by auto
  have b'_insertion' : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var 0) = b'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") apply auto
    by (simp add: degree0isovarspar degree_isovarspar)
  have insertion_into_1 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (Const 1) var 0) = 1"
    by (simp add: const_lookup_zero insertion_const)
  have twominusone : "((2-1)::nat) = 1" by auto
  show ?thesis
  proof(cases "MPoly_Type.degree p var = 0")
    case True
    have simp: "(convertDerivative var p)=Atom(Less p)"
      using True
      by auto
    have azero : "a'=0"
      by (metis MPoly_Type.insertion_zero True a'_insertion isolate_variable_sparse_ne_zeroD nat.simps(3) not_less numeral_2_eq_2 zero_less_iff_neq_zero)
    have bzero : "b'=0"
      using True b'_insertion isovar_greater_degree by fastforce
    show ?thesis unfolding fields substInfinitesimalLinearUni.simps
        convertDerivativeUni.simps linearSubstitutionUni.simps map_atomUni.simps evalUni.simps evalUni_if aEvalUni.simps
        Rings.mult_zero_class.mult_zero_left Rings.mult_zero_class.mult_zero_right Groups.add_0 azero bzero
        substInfinitesimalLinear.simps convertDerivative.simps[of _ p] True simp liftmap.simps 
        linear_substitution.simps
      apply (auto simp add:True) 
      unfolding c'_insertion by auto
  next
    case False
    then have degnot0 : "MPoly_Type.degree p var ≠ 0" by auto
    then show ?thesis
    proof(cases "MPoly_Type.degree p var = 1")
      case True
      then have simp : "convertDerivative var p = Or (fm.Atom (Less p)) (And (fm.Atom (Eq p)) (fm.Atom (Less (derivative var p))))"
        by (metis One_nat_def Suc_eq_plus1 add_right_imp_eq convertDerivative.simps degnot0 degree_derivative zero_less_one)
      have azero : "a'=0"
        by (metis MPoly_Type.insertion_zero One_nat_def True a'_insertion isovar_greater_degree lessI numeral_2_eq_2)
      have degderiv : "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1) var = 0"
        using degree_mult
        by (simp add: degree_isovarspar mult_one_right) 
      show ?thesis
        unfolding fields substInfinitesimalLinearUni.simps
          convertDerivativeUni.simps linearSubstitutionUni.simps map_atomUni.simps evalUni.simps evalUni_if aEvalUni.simps
          Rings.mult_zero_class.mult_zero_left Rings.mult_zero_class.mult_zero_right Groups.add_0 azero
          substInfinitesimalLinear.simps True simp liftmap.simps 
          linear_substitution.simps eval_Or eval_And liftb liftc 
        apply auto
        unfolding derivative_def True insertion_sub insertion_mult c'_insertion b'_insertion assms lift00 apply auto
        unfolding insertion_sub insertion_mult c'_insertion b'_insertion assms lift00
        apply (smt diff_divide_eq_iff divide_less_0_iff mult_less_0_iff)
        apply (smt mult_imp_less_div_pos neg_less_divide_eq zero_le_mult_iff)
        using assms(4) mult.commute nonzero_mult_div_cancel_left
        apply smt
        unfolding degderiv apply auto
        unfolding isolate_variable_sparse_mult apply auto
        unfolding insertion_mult defer
        apply (smt assms(4) diff_divide_eq_iff divide_less_0_iff mult_less_0_iff)
        defer
        using assms(4) apply blast
        unfolding b'_insertion' insertion_into_1 apply auto
        by (smt assms(4) less_divide_eq mult_pos_neg2 no_zero_divisors zero_less_mult_pos)
    next
      case False
      then have degreetwo : "MPoly_Type.degree p var = 2" using degnot0
        by (metis One_nat_def degree_convert_eq h less_2_cases less_Suc_eq numeral_2_eq_2 numeral_3_eq_3) 
      have two : "(2::nat) = Suc(Suc 0)" by auto
      have sum : "(∑i = 0..<2. isolate_variable_sparse p var i * (- c) ^ i * b ^ (2 - i)) =
                  isolate_variable_sparse p var 0 * (- c) ^ 0 * b ^ (2 - 0) + isolate_variable_sparse p var 1 * (- c) ^ 1 * b ^ (2 - 1) "
        unfolding Set_Interval.comm_monoid_add_class.sum.atLeast0_lessThan_Suc two by auto
      have a : "isolate_variable_sparse p var (Suc (Suc 0)) ≠ 0"
        by (metis degnot0 degree_isovarspar degreetwo isolate_variable_sparse_degree_eq_zero_iff numeral_2_eq_2) 
      have b : "((Var var * Const 2) :: real mpoly) ≠ (0::real mpoly)"
        by (metis MPoly_Type.degree_zero ExecutiblePolyProps.degree_one mult_eq_0_iff nonzero_const_is_nonzero zero_neq_numeral zero_neq_one)
      have degreedeg1 : "MPoly_Type.degree
               (isolate_variable_sparse p var (Suc 0) * Const 1 +
                isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
               var  = 1"
        apply(rule degree_less_sum'[where n ="0"])
        apply (simp add: degree_isovarspar mult_one_right) defer
        apply simp
        using degree_mult[OF a b, of var]
        by (metis (no_types, hide_lams) ExecutiblePolyProps.degree_one add.left_neutral b degree_const degree_isovarspar degree_mult mult.commute mult_zero_class.mult_zero_right)
      have simp : "(convertDerivative var p) = Or (fm.Atom (Less p))
     (And (fm.Atom (Eq p))
       (Or (fm.Atom (Less (derivative var p)))
         (And (fm.Atom (Eq (derivative var p))) (fm.Atom (Less (derivative var (derivative var p)))))))"
        using degreetwo
        by (metis One_nat_def Suc_1 Suc_eq_plus1 add_diff_cancel_right' convertDerivative.simps degree_derivative neq0_conv zero_less_Suc)
      have a : "insertion (nth_default 0 (xs'@x#xs))
     (isolate_variable_sparse
       (isolate_variable_sparse p var (Suc 0) * Const 1 +
        isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
       var 0) = b'" unfolding isovarspar_sum isolate_variable_sparse_mult apply auto
        unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right
          Groups.group_add_class.add.group_left_neutral
        by (simp add: b'_insertion' isolate_var_0 mult_one_right)
      have b : "insertion (nth_default 0 (xs'@x#xs))
     (isolate_variable_sparse
       (isolate_variable_sparse p var (Suc 0) * Const 1 +
        isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
       var (Suc 0)) = 2 * a'"
        unfolding isovarspar_sum isolate_variable_sparse_mult apply auto
        unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right
          Groups.group_add_class.add.group_left_neutral
        unfolding insertion_add insertion_mult insertion_const
        by (metis MPoly_Type.insertion_one MPoly_Type.insertion_zero One_nat_def a'_insertion add.commute add.right_neutral degree0isovarspar degree_isovarspar isolate_var_one isovar_greater_degree mult.commute mult.right_neutral mult_zero_class.mult_zero_right numeral_2_eq_2 zero_less_one)
      have simp_insertion_blob : "insertion (nth_default 0 (xs'@x#xs))
     (isolate_variable_sparse
        (isolate_variable_sparse p var (Suc 0) * Const 1 +
         isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
        var 0 *
       b -
       isolate_variable_sparse
        (isolate_variable_sparse p var (Suc 0) * Const 1 +
         isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
        var (Suc 0) *
       c) = b' * B - 2 * a' * C"
        unfolding insertion_sub insertion_mult assms a b by auto
      have a : "isolate_variable_sparse
       (isolate_variable_sparse p var (Suc 0) * Const 1 +
        isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
       var (Suc 0) ≠ 0"
        by (metis MPoly_Type.degree_zero One_nat_def degreedeg1 isolate_variable_sparse_degree_eq_zero_iff zero_neq_one) 
      have b' : "(Const 1::real mpoly) ≠ 0"
        by (simp add: nonzero_const_is_nonzero)
      have degreeblob : "MPoly_Type.degree
               (isolate_variable_sparse
                 (isolate_variable_sparse p var (Suc 0) * Const 1 +
                  isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
                 var (Suc 0) *
                Const 1)
               var = 0" 
        unfolding degree_mult[OF a b', of var]
        by (simp add: degree_isovarspar degree_eq_iff monomials_Const)
      have otherblob : "insertion (nth_default 0 (xs'@x#xs))
      (isolate_variable_sparse
        (isolate_variable_sparse
          (isolate_variable_sparse p var (Suc 0) * Const 1 +
           isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
          var (Suc 0) *
         Const 1)
        var 0) = 2 * a'" using b
        by (simp add: degree0isovarspar degree_isovarspar mult_one_right)

      have "(c' * B2 - b' * C * B + a' * C2 < 0) = ((c' * B2 - b' * C * B + a' * C2)/(B2) < 0)"
        by (simp add: assms(4) divide_less_0_iff)
      also have "... = (((c' * B2)/(B2) - (b' * C * B)/(B2) + (a' * C2)/(B2)) < 0)"
        by (metis (no_types, lifting) add_divide_distrib diff_divide_distrib )
      also have "... = (a' * (C / B)2 - b' * C / B + c' < 0)"
      proof -
        { assume "c' + a' * (C / B)2 - b' * (C / B) < 0"
          then have ?thesis
            by (simp add: assms(4) power2_eq_square) }
        moreover
        { assume "¬ c' + a' * (C / B)2 - b' * (C / B) < 0"
          then have ?thesis
            by (simp add: power2_eq_square) }
        ultimately show ?thesis
          by fastforce
      qed
      finally have h1: "(c' * B2 - b' * C * B + a' * C2 < 0) = (a' * (C / B)2 - b' * C / B + c' < 0)"
        .
      have "(c' * B2 - b' * C * B + a' * C2 = 0) = ((c' * B2 - b' * C * B + a' * C2)/(B2) = 0)"
        by (simp add: assms(4))
      also have "... = (((c' * B2)/(B2) - (b' * C * B)/(B2) + (a' * C2)/(B2)) = 0)"
        by (metis (no_types, lifting) add_divide_distrib diff_divide_distrib )
      also have "... = (a' * (C / B)2 - b' * C / B + c' = 0)"
      proof -
        { assume "c' + a' * (C * (C / (B * B))) - b' * (C / B) ≠ 0"
          then have ?thesis
            by (simp add: assms(4) power2_eq_square) }
        moreover
        { assume "c' + a' * (C * (C / (B * B))) - b' * (C / B) = 0"
          then have ?thesis
            by (simp add: power2_eq_square) }
        ultimately show ?thesis
          by fastforce
      qed
      finally have h2 : "(c' * B2 - b' * C * B + a' * C2 = 0) = (a' * (C / B)2 - b' * C / B + c' = 0)"
        .
      have h3 : "((b' * B - 2 * a' * C) * B < 0) = (b' < 2 * a' * C / B)"
        by (smt assms(4) less_divide_eq zero_le_mult_iff)
      have h4 : "(b' * B = 2 * a' * C) = (b' = 2 * a' * C / B)"
        by (simp add: assms(4) nonzero_eq_divide_eq)
      show ?thesis unfolding fields substInfinitesimalLinearUni.simps
          convertDerivativeUni.simps linearSubstitutionUni.simps map_atomUni.simps evalUni.simps evalUni_if aEvalUni.simps
          Rings.mult_zero_class.mult_zero_left Rings.mult_zero_class.mult_zero_right Groups.add_0
          substInfinitesimalLinear.simps degreetwo simp liftmap.simps 
          linear_substitution.simps eval_Or eval_And liftb liftc 
        apply simp 
        unfolding derivative_def degreetwo insertion_sub insertion_mult c'_insertion b'_insertion assms  apply simp
        unfolding sum insertion_add insertion_mult insertion_pow insertion_neg assms
        unfolding b'_insertion2 c'_insertion a'_insertion
        unfolding Power.power_class.power.power_0  Groups.monoid_mult_class.mult_1_right
          Groups.cancel_comm_monoid_add_class.diff_zero Power.monoid_mult_class.power_one_right
          twominusone degreedeg1 apply simp
        unfolding insertion_mult assms simp_insertion_blob degreeblob 
        unfolding insertion_mult insertion_sub assms otherblob apply simp
        unfolding otherblob h1 h2 h3 h4 unfolding lift00 insertion_neg assms insertion_isovarspars_free insertion_sum insertion_mult insertion_sub degree0isovarspar degree_isovarspar mult_one_right insertion_sum_var insertion_pow insertion_neg sum
        unfolding assms b'_insertion c'_insertion a'_insertion insertion_neg insertion_mult insertion_add insertion_pow apply simp
        by (smt assms(2) assms(3) b'_insertion h1 h2 h3 h4 insertion_mult insertion_sub mult_one_right simp_insertion_blob)
    qed
  qed
qed
lemma convert_substInfinitesimalLinear: 
  assumes "convert_atom var a (xs'@x#xs) = Some(a')"
  assumes "insertion (nth_default 0 (xs'@x#xs)) b = B"
  assumes "insertion (nth_default 0 (xs'@x#xs)) c = C"
  assumes "B ≠ 0"
  assumes "var∉(vars b)"
  assumes "var∉(vars c)"
  assumes "length xs' = var"
  shows "eval (substInfinitesimalLinear var (-c) b a) (xs'@x#xs) = evalUni (substInfinitesimalLinearUni B C a') x"
  using assms
proof(cases a)
  case (Less p)
  have "∃p'. convert_poly var p (xs'@x#xs) = Some p'"
    using Less assms(1) apply(cases "MPoly_Type.degree p var < 3") by auto
  then obtain p' where p'_def : "convert_poly var p (xs'@x#xs) = Some p'" by auto
  have A'_simp :  "a' = LessUni p'"
    using assms Less
    using p'_def by auto 
  have h1 : "eval (convertDerivative var p) (xs'@x#xs) = evalUni (convertDerivativeUni p') x" using convert_convertDerivative
    apply ( cases p')
    using A'_simp Less assms by auto 
  show ?thesis unfolding A'_simp using convert_substInfinitesimalLinear_less[OF p'_def assms(2-7)] unfolding Less by auto
next
  case (Eq p)
  define p' where "p' = (case convert_poly var p (xs'@x#xs) of Some p' ⇒ p')"
  have A'_simp :  "a' = EqUni p'"
    using assms Eq
    using p'_def by auto 
  show ?thesis
    unfolding Eq A'_simp substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps
    using convert_allZero A'_simp Eq assms by auto
next
  case (Leq p)
  have "∃p'. convert_poly var p (xs' @ x # xs) = Some p'"
    using assms(1) unfolding Leq apply auto apply(cases "MPoly_Type.degree p var < 3") by auto
  then obtain p' where p'_def : "convert_poly var p (xs' @ x # xs) = Some p'" by metis
  have A'_simp :  "a' = LeqUni p'"
    using assms Leq
    using p'_def by auto 
  have h1 : "eval (convertDerivative var p) (xs'@x#xs) = evalUni (convertDerivativeUni p') x" using convert_convertDerivative
    apply(cases p')
    using A'_simp Leq assms by auto
  show ?thesis unfolding A'_simp Leq substInfinitesimalLinear.simps eval_Or substInfinitesimalLinearUni.simps evalUni.simps
    using convert_substInfinitesimalLinear_less[OF p'_def assms(2-7)]
      convert_allZero[OF p'_def assms(7)] by simp
next
  case (Neq p)
  have "∃p'. convert_poly var p (xs' @ x # xs) = Some p'"
    using assms(1) unfolding Neq apply auto apply(cases "MPoly_Type.degree p var < 3") by auto
  then obtain p' where p'_def : "convert_poly var p (xs' @ x # xs) = Some p'" by metis
  have A'_simp :  "a' = NeqUni p'"
    using assms Neq
    using p'_def by auto 
  show ?thesis
    unfolding Neq A'_simp substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps
    using convert_allZero[OF p'_def assms(7)]
    by (metis A'_simp Neq assms(1) assms(7) convert_substNegInfinity eval.simps(6) eval_neg substNegInfinityUni.simps(4) substNegInfinity.simps(4))  
qed


lemma either_or:
  fixes r :: "real"
  assumes a: "(∃y'>r. ∀x∈{r<..y'}.  (aEvalUni (EqUni (a, b, c)) x) ∨ (aEvalUni (LessUni (a, b, c)) x))"
  shows "(∃y'>r. ∀x∈{r<..y'}.  (aEvalUni (EqUni (a, b, c)) x)) ∨ 
  (∃y'>r. ∀x∈{r<..y'}.  (aEvalUni (LessUni (a, b, c)) x))"
proof  (cases "a = 0 ∧ b = 0 ∧ c= 0")
  case True
  then have "(∃y'>r. ∀x∈{r<..y'}.  (aEvalUni (EqUni (a, b, c)) x))"
    using assms by auto
  then show ?thesis
    by blast 
next
  case False 
  then have noz: "a≠0 ∨ b≠0 ∨ c≠0" by auto
  obtain y1' where y1prop: "y1' > r ∧ (∀x∈{r<..y1'}. (aEvalUni (EqUni (a, b, c)) x) ∨ (aEvalUni (LessUni (a, b, c)) x))"
    using a by auto
  obtain y2' where y2prop: "y2' > r ∧ (∀x∈{r<..y2'}. a * x2 + b * x + c ≠ 0)"
    using noz nonzcoeffs[of a b c] by auto
  let ?y = "min y1' y2'"
  have ygt: "?y > r" using y1prop y2prop by auto
  have "∀x∈{r<..?y}. (aEvalUni (LessUni (a, b, c)) x)"
    using y1prop y2prop greaterThanAtMost_iff
    by force 
  then show ?thesis using ygt
    by blast 
qed

lemma infinitesimal_linear'_helper :
  assumes at_is: "At = LessUni p ∨ At = EqUni p"
  assumes "B ≠ 0"
  shows "((∃y'::real>-C/B. ∀x::real ∈{-C/B<..y'}. aEvalUni At x)
      = evalUni (substInfinitesimalLinearUni B C At) x)"
proof (cases "At = LessUni p")
  case True
  then have LessUni: "At = LessUni p" by auto
  then show ?thesis proof(cases p)
    case (fields a b c) 
    then show ?thesis 
      unfolding LessUni fields 
      using one_root_a_lt0[where r="C/B", where a= "a", where b="b",where c= "c"] apply(auto) 
      using continuity_lem_lt0_expanded[where a= "a", where b = "2 * a * C / B ", where c = "c"]  apply (auto) 
      using continuity_lem_gt0_expanded[where a = "a", where b = "2 * a * C / B",where c = "c", where r = "- (C / B)"] apply (auto) 
      apply (meson less_eq_real_def linorder_not_less) 
      using one_root_a_gt0[where r = "C/B", where a = "a", where b="b", where c="c"] apply (auto) 
      using continuity_lem_lt0_expanded[where a= "a", where b = "2 * a * C / B", where c= "c"]
      apply (auto)
      using continuity_lem_gt0_expanded[where a = "a", where b = "2 * a * C / B",where c = "c", where r = "- (C / B)"]
      apply (auto) apply (meson less_eq_real_def linorder_not_less) 
      using case_d1 apply (auto)
      using continuity_lem_lt0_expanded[where a= "a", where b = "b", where c= "c"]
      apply (auto)
      using continuity_lem_gt0_expanded[where a = "a", where b = "b",where c = "c", where r = "- (C / B)"]
      apply (auto) apply (meson less_eq_real_def linorder_not_less) 
      using case_d4 apply (auto) 
      using continuity_lem_lt0_expanded[where a= "a", where b = "b", where c= "c"]
      apply (auto)
      using continuity_lem_gt0_expanded[where a = "a", where b = "b",where c = "c", where r = "- (C / B)"]
      apply (auto)
      by (meson less_eq_real_def linorder_not_le) 
  qed    
next
  case False
  then have EqUni: "At = EqUni p" using at_is by auto
  then show ?thesis proof(cases p)
    case (fields a b c)
    show ?thesis
      apply(auto simp add:EqUni fields) 
      using continuity_lem_eq0[where r= "-(C/B)"] apply blast
      using continuity_lem_eq0[where r= "-(C/B)"] apply blast
      using continuity_lem_eq0[where r= "-(C/B)"] apply blast
      using linordered_field_no_ub by blast
  qed
qed 

(* I assume substInfinitesimalLinearUni' was supposed to be substInfinitesimalLinearUni?*)
lemma infinitesimal_linear' :
  assumes "B ≠ 0"
  shows "(∃y'::real>-C/B. ∀x::real ∈{-C/B<..y'}. aEvalUni At x)
      = evalUni (substInfinitesimalLinearUni B C At) x"
proof(cases At)
  case (LessUni p) 
  then show ?thesis using infinitesimal_linear'_helper[of At p B C] assms by auto
next
  case (EqUni p)
  then show ?thesis  using infinitesimal_linear'_helper[of At p B C] assms by (auto) 
next
  case (LeqUni p)
  then show ?thesis proof(cases p)
    case (fields a b c) 
    have same: "∀x. aEvalUni (LeqUni p) x = (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x)" 
      apply (simp add: fields)
      by force 
    have "⋀a b c.
       At = LeqUni p ⟹
       p = (a, b, c) ⟹
       (∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) =
       evalUni (substInfinitesimalLinearUni B C At) x "
    proof - 
      fix a b c
      assume atis: "At = LeqUni p"
      assume p_is: " p = (a, b, c)"
      have s1: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = (∃y'>- C / B. ∀x∈{- C / B<..y'}.  (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x))"
        using atis same aEvalUni.simps(2) aEvalUni.simps(3) fields less_eq_real_def
        by blast
      have s2: "... = (∃y'>- C / B. ∀x∈{- C / B<..y'}.  (aEvalUni (EqUni p) x)) ∨ (∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (LessUni p) x))"
        using either_or[where r = "-C/B"] p_is 
        by blast 
      have eq1: "(∃y'>- C / B. ∀x∈{- C / B<..y'}.  (aEvalUni (EqUni p) x)) =  (evalUni (substInfinitesimalLinearUni B C (EqUni p)) x)"
        using infinitesimal_linear'_helper[where At = "EqUni p", where p = "p", where B = "B", where C= "C"] 
          assms by auto
      have eq2: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (LessUni p) x)) = (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x)"
        using infinitesimal_linear'_helper[where At = "LessUni p", where p = "p", where B = "B", where C= "C"] 
          assms by auto
      have z1: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = ((evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x))"
        using s1 s2 eq1 eq2  by auto
      have z2: "(evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x) = evalUni (substInfinitesimalLinearUni B C (LeqUni p)) x" 
        by auto
      have z3: "(evalUni (substInfinitesimalLinearUni B C At) x) = evalUni (substInfinitesimalLinearUni B C (LeqUni p)) x"
        using LeqUni by auto
      then have z4: "(evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x) = (evalUni (substInfinitesimalLinearUni B C At) x) "
        using z2 z3 by auto
      let ?a = "(evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x)"
      let ?b = "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x)"
      let ?c = "(evalUni (substInfinitesimalLinearUni B C At) x)"
      have t1: "?b = ?a" using z1 by auto
      have t2: "?a = ?c" using z4
        by (simp add: atis)
      then have "?b = ?c" using t1 t2 by auto
      then show "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = evalUni (substInfinitesimalLinearUni B C At) x"
        by auto
    qed
    then show ?thesis
      using LeqUni fields by blast 
  qed
next
  case (NeqUni p)
  then show ?thesis proof(cases p)
    case (fields a b c)
    then show ?thesis unfolding NeqUni fields using nonzcoeffs  by (auto) 
  qed
qed

fun quadraticSubUni :: "real ⇒ real ⇒ real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where
  "quadraticSubUni a b c d A = (if aEvalUni A ((a+b*sqrt(c))/d) then TrueFUni else FalseFUni)"

fun substInfinitesimalQuadraticUni :: "real ⇒ real ⇒ real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where
  "substInfinitesimalQuadraticUni a b c d (EqUni p) = allZero' p"|
  "substInfinitesimalQuadraticUni a b c d (LessUni p) = map_atomUni (quadraticSubUni a b c d) (convertDerivativeUni p)"|
  "substInfinitesimalQuadraticUni a b c d (LeqUni p) = OrUni(map_atomUni (quadraticSubUni a b c d) (convertDerivativeUni p)) (allZero' p)"|
  "substInfinitesimalQuadraticUni a b c d (NeqUni p) = negUni (allZero' p)"


lemma weird :
  fixes D::"real"
  assumes dneq: "D ≠ (0::real)"
  shows 
    "((a'::real) * (((A::real) + (B::real) * sqrt (C::real)) / (D::real))2 + (b'::real) * (A + B * sqrt C) / D + c' < 0 ∨
     a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + (c'::real) = 0 ∧
     (b' + a' * (A + B * sqrt C) * 2 / D < 0 ∨
      b' + a' * (A + B * sqrt C) * 2 / D = 0 ∧ 2 * a' < 0)) =
    (a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + c' < 0 ∨
     a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + c' = 0 ∧
     (2 * a' * (A + B * sqrt C) / D + b' < 0 ∨
      2 * a' * (A + B * sqrt C) / D + b' = 0 ∧ a' < 0))"
proof (cases "(a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + c' < 0)")
  case True
  then show ?thesis
    by auto
next
  case False
  have "a' * (A + B * sqrt C) * 2 = 2 * a' * (A + B * sqrt C)" by auto
  then have "a' * (A + B * sqrt C) * 2 / D =2 * a' * (A + B * sqrt C) / D "
    using dneq by simp 
  then have "b' + a' * (A + B * sqrt C) * 2 / D = 2 * a' * (A + B * sqrt C) / D + b'"
    using add.commute by simp
  then have "(b' + a' * (A + B * sqrt C) * 2 / D < 0 ∨ b' + a' * (A + B * sqrt C) * 2 / D = 0 ∧ a' < 0)
   = (2 * a' * (A + B * sqrt C) / D + b' < 0 ∨ 2 * a' * (A + B * sqrt C) / D + b' = 0 ∧ a' < 0)"
    by (simp add: ‹b' + a' * (A + B * sqrt C) * 2 / D = 2 * a' * (A + B * sqrt C) / D + b'›)
  then have "(a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + c' = 0 ∧
     (b' + a' * (A + B * sqrt C) * 2 / D < 0 ∨ b' + a' * (A + B * sqrt C) * 2 / D = 0 ∧ a' < 0)) =
    (a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + c' = 0 ∧
     (2 * a' * (A + B * sqrt C) / D + b' < 0 ∨ 2 * a' * (A + B * sqrt C) / D + b' = 0 ∧ a' < 0))"
    by blast
  then show ?thesis using False by simp
qed 

lemma convert_substInfinitesimalQuadratic_less :
  assumes "convert_poly var p (xs'@x#xs) = Some p'"
  assumes "insertion (nth_default 0 (xs'@x#xs)) a = A"
  assumes "insertion (nth_default 0 (xs'@x#xs)) b = B"
  assumes "insertion (nth_default 0 (xs'@x#xs)) c = C"
  assumes "insertion (nth_default 0 (xs'@x#xs)) d = D"
  assumes "D ≠ 0"
  assumes "0 ≤ C"
  assumes "var∉(vars a)"
  assumes "var∉(vars b)"
  assumes "var∉(vars c)"
  assumes "var∉(vars d)"
  assumes "length xs' = var"
  shows "eval (quadratic_sub_fm var a b c d (convertDerivative var p)) (xs'@x#xs) = evalUni (map_atomUni (quadraticSubUni A B C D) (convertDerivativeUni p')) x"
proof(cases p')
  case (fields a' b' c')
  have h : "convert_poly var p (xs'@x#xs) = Some (a', b', c')"
    using assms fields by auto
  have h2 : "∃F'. convert_fm var (convertDerivative var p) (xs'@x#xs) = Some F'"
    unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "derivative var p"] convertDerivative.simps[of _ "derivative var (derivative var p)"]
    apply (auto simp del: convertDerivative.simps)
    using degree_convert_eq h apply blast
    using assms(1) degree_convert_eq apply blast
    using degree_derivative apply fastforce
    apply (metis degree_convert_eq h   numeral_3_eq_3 )
    apply (metis (no_types, lifting) One_nat_def add.right_neutral add_Suc_right degree_derivative less_Suc_eq_0_disj less_Suc_eq_le neq0_conv numeral_3_eq_3)
    apply (metis One_nat_def Suc_eq_plus1 degree_derivative less_2_cases less_Suc_eq nat_neq_iff numeral_3_eq_3 one_add_one)
    apply (meson assms(1) degree_convert_eq)
    using degree_derivative apply fastforce
    using assms(1) degree_convert_eq apply blast
    apply (meson assms(1) degree_convert_eq)
    apply (metis degree_derivative less_Suc_eq less_add_one not_less_eq numeral_3_eq_3)
    apply (meson assms(1) degree_convert_eq)
    apply (metis (no_types, hide_lams) Suc_1 Suc_eq_plus1 degree_derivative less_2_cases less_Suc_eq numeral_3_eq_3)
    using assms(1) degree_convert_eq by blast
  have c'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) = c'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto
  then have c'_insertion'' : "⋀x. insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0) = c'"
    using assms(12) not_in_isovarspar[of p var 0 "isolate_variable_sparse p var 0", OF HOL.refl]
    by (metis list_update_length not_contains_insertion)
  have b'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) = b'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto
  then have b'_insertion'' : "⋀x. insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)) = b'"
    using assms(12) not_in_isovarspar[of p var "Suc 0" "isolate_variable_sparse p var (Suc 0)", OF HOL.refl]
    by (metis list_update_length not_contains_insertion)
  then have b'_insertion2 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) = b'"
    by auto
  have a'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 2) = a'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto
  then have a'_insertion'' : "⋀x. insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2) = a'"
    using assms(12) not_in_isovarspar[of p var 2 "isolate_variable_sparse p var 2", OF HOL.refl]
    by (metis list_update_length not_contains_insertion)
  have liftb : "liftPoly 0 0 b = b" using lift00 by auto
  have liftc : "liftPoly 0 0 c = c" using lift00 by auto
  have b'_insertion' : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var 0) = b'"
    using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") apply auto
    using degree0isovarspar degree_isovarspar by auto
  have insertion_into_1 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (Const 1) var 0) = 1"
    by (simp add: const_lookup_zero insertion_const)
  have twominusone : "((2-1)::nat) = 1" by auto
  have length0 : "var < length (xs'@x#xs)" using assms by auto
  have altinserta : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) a = A"
    using assms by (metis list_update_length not_contains_insertion)
  have altinserta' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) a = A"
    using assms by (metis list_update_length not_contains_insertion)
  have altinsertb : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) b = B"
    using assms by (metis list_update_length not_contains_insertion)
  have altinsertb' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) b = B"
    using assms by (metis list_update_length not_contains_insertion)
  have altinsertc : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) c = C"
    using assms by (metis list_update_length not_contains_insertion)
  have altinsertc' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) c = C"
    using assms by (metis list_update_length not_contains_insertion)
  have altinsertd : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) d = D" 
    using assms by (metis list_update_length not_contains_insertion)
  have altinsertd' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) d = D" 
    using assms by (metis list_update_length not_contains_insertion)
  have freeInQuadraticSub : "∀At. eval (quadratic_sub var a b c d At) ((xs'@x#xs)[var := sqrt C]) = eval (quadratic_sub var a b c d At) ((xs'@x#xs))"
    by (metis assms(10) assms(11) assms(8) assms(9) free_in_quad list_update_id var_not_in_eval)
  have quad : "⋀At. (eval (quadratic_sub var a b c d At) (xs'@x#xs) =
  aEval At ((xs'@x#xs)[var := (A + B * sqrt C) / D]))"
    using quadratic_sub[OF length0 assms(6-7) assms(10) altinserta altinsertb altinsertc altinsertd, symmetric]
    using freeInQuadraticSub  by auto 
  show ?thesis
  proof(cases "MPoly_Type.degree p var = 0")
    case True
    then have simp: "(convertDerivative var p)=Atom(Less p)"
      by auto
    have azero : "a'=0"
      by (metis MPoly_Type.insertion_zero True a'_insertion isolate_variable_sparse_ne_zeroD nat.simps(3) not_less numeral_2_eq_2 zero_less_iff_neq_zero)
    have bzero : "b'=0"
      using True b'_insertion isovar_greater_degree by fastforce
    define p1 where "p1 = isolate_variable_sparse p var 0"
    have degree_p1: "MPoly_Type.degree p1 var = 0" unfolding p1_def
      by (simp add: degree_isovarspar)
    define p2 where "p2 = isolate_variable_sparse p1 var 0 * Const 0 * Var var + isolate_variable_sparse p1 var 0 * Const 1"
    define A where "A = isolate_variable_sparse p2 var 0"
    define B where "B = isolate_variable_sparse p2 var (Suc 0)"
    show ?thesis
      unfolding substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps
        fields
        convertDerivativeUni.simps map_atomUni.simps quadraticSubUni.simps aEvalUni.simps evalUni.simps evalUni_if
        Rings.mult_zero_class.mult_zero_left Groups.add_0 Rings.mult_zero_class.mult_zero_right
        True simp azero bzero 
        quadratic_sub_fm.simps quadratic_sub_fm_helper.simps liftmap.simps lift00  
        quad aEval.simps
      apply (simp add:True c'_insertion p1_def[symmetric] degree_p1 p2_def[symmetric] A_def[symmetric] B_def[symmetric]) 
      unfolding A_def B_def p2_def p1_def  degree0isovarspar[OF True] isovarspar_sum mult_one_right mult_zero_right mult_zero_left const_lookup_zero const_lookup_suc
      apply simp
      unfolding insertion_add insertion_sub insertion_mult insertion_pow insertion_const c'_insertion apply simp
      using ‹isolate_variable_sparse p var 0 = p› b'_insertion2 bzero c'_insertion by force
  next
    case False
    then have degreenonzero : "MPoly_Type.degree p var ≠0" by auto
    show ?thesis
    proof(cases "MPoly_Type.degree p var = 1")
      case True
      then have simp : "convertDerivative var p = Or (fm.Atom (Less p)) (And (fm.Atom (Eq p)) (fm.Atom (Less (derivative var p))))"
        by (metis One_nat_def Suc_eq_plus1 add_right_imp_eq convertDerivative.simps degree_derivative degreenonzero less_numeral_extra(1))
      have azero : "a'=0"
        by (metis MPoly_Type.insertion_zero One_nat_def True a'_insertion isovar_greater_degree lessI numeral_2_eq_2)
      have degderiv : "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1) var = 0"
        using degree_mult
        by (simp add: degree_isovarspar mult_one_right)
      have thing : "var<length (xs'@((A + B * sqrt C) / D # xs))" using assms by auto
      have insertp : "insertion (nth_default 0 (xs'@((A + B * sqrt C) / D # xs))) p = b' * (A + B * sqrt C) / D + c'"
        using sum_over_degree_insertion[OF thing True, of "(A + B * sqrt C) / D", symmetric] unfolding list_update_length  assms(12)[symmetric] apply simp
        unfolding assms(12) unfolding c'_insertion'' b'_insertion''  by auto
      have insertb : "insertion (nth_default 0 (xs'@(A + B * sqrt C) / D # xs))
      (isolate_variable_sparse p var (Suc 0) * Const 1) = b'"
        unfolding insertion_mult insertion_const b'_insertion'' by simp
      show ?thesis
        unfolding substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps
          fields
          convertDerivativeUni.simps map_atomUni.simps quadraticSubUni.simps aEvalUni.simps evalUni.simps evalUni_if
          Rings.mult_zero_class.mult_zero_left Groups.add_0 Rings.mult_zero_class.mult_zero_right
          True simp azero 
          quadratic_sub_fm.simps quadratic_sub_fm_helper.simps liftmap.simps lift00  
          quad aEval.simps eval.simps derivative_def Groups.monoid_add_class.add_0_right
        apply simp
        unfolding insertp insertb insertion_mult insertion_const
        using assms(12) b'_insertion'' insertp by force
    next
      case False
      then have degree2 : "MPoly_Type.degree p var = 2" using degreenonzero
        using h less_Suc_eq by fastforce 
      have simp : "(convertDerivative var p) = Or (fm.Atom (Less p))
     (And (fm.Atom (Eq p))
       (Or (fm.Atom (Less (derivative var p)))
         (And (fm.Atom (Eq (derivative var p))) (fm.Atom (Less (derivative var (derivative var p)))))))"
        by (metis One_nat_def Suc_eq_plus1 add_diff_cancel_right' convertDerivative.simps degree2 degree_derivative degreenonzero neq0_conv one_add_one)
      have insertionp : "var < length (xs'@(A + B * sqrt C) / D # xs)" using assms by auto
      have three : "3 = Suc(Suc(Suc(0)))" by auto
      have two : "2 = Suc(Suc(0))" by auto
      have insertionp : "insertion (nth_default 0 ((xs'@x # xs)[var := (A + B * sqrt C) / D])) p = a' * ((A + B * sqrt C) / D)2 + b' * (A + B * sqrt C) / D + c'"
        using sum_over_degree_insertion[OF insertionp degree2, of "(A + B * sqrt C) / D", symmetric] unfolding  
          a'_insertion[symmetric] b'_insertion[symmetric] c'_insertion[symmetric] 
          insertion_isovarspars_free[of _ _ "(A + B * sqrt C) / D" _ _ x]
        unfolding two apply simp
        using assms(12) by force
      have insertion_simp : "insertion (nth_default 0 ((xs' @ x # xs)[var := (A + B * sqrt C) / D])) = insertion (nth_default 0 ((xs' @ ((A + B * sqrt C) / D) # xs)))"
        using assms
        by (metis list_update_length) 
      have degreeone : "MPoly_Type.degree
                  (isolate_variable_sparse p var (Suc 0) * Const 1 +
                   isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
                  var = 1"
        apply(rule degree_less_sum'[where n=0])
        apply (simp add: degree_isovarspar mult_one_right)
        apply (smt One_nat_def ExecutiblePolyProps.degree_one degree2 degree_const degree_isovarspar degree_mult degreenonzero isolate_variable_sparse_degree_eq_zero_iff mult.commute nonzero_const_is_nonzero numeral_2_eq_2 plus_1_eq_Suc)
        by simp
      have zero1 : " insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs))
     (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var (Suc 0)) = 0"
        by (simp add: degree_isovarspar isovar_greater_degree) 
      have zero2 : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs))
      (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var 0) = a'"
        using a'_insertion'' degree0isovarspar degree_isovarspar numeral_2_eq_2 by force
      have zero3 : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse (Var var) var (Suc 0)) = 1"
        using isolate_var_one by fastforce
      have zero4 : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs))
      (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var (Suc 0)) = 0"
        by (simp add: degree_isovarspar isovar_greater_degree)
      have insertiona' : " insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs))
       (isolate_variable_sparse
         (isolate_variable_sparse p var (Suc 0) * Const 1 +
          isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2)
         var (Suc 0) *
        Const 1) = 2 * a'"
        unfolding isovarspar_sum isolate_variable_sparse_mult apply auto
        unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right
          Groups.group_add_class.add.group_left_neutral
        unfolding insertion_add insertion_mult insertion_const b'_insertion' apply auto
        unfolding zero1 zero2 zero3 zero4 by auto
      have a' :  "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse p var (Suc (Suc 0))) = a'"
        unfolding two[symmetric] unfolding a'_insertion'' by auto
      have var: "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (Var var) = (A + B * sqrt C) / D" using assms
        by (metis insertion_simp insertion_var length0)
      show ?thesis
        unfolding substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps
          fields
          convertDerivativeUni.simps map_atomUni.simps quadraticSubUni.simps aEvalUni.simps evalUni.simps evalUni_if
          Rings.mult_zero_class.mult_zero_left Groups.add_0 Rings.mult_zero_class.mult_zero_right
          degree2 simp
          quadratic_sub_fm.simps quadratic_sub_fm_helper.simps liftmap.simps lift00   Groups.monoid_add_class.add_0_right
          quad aEval.simps eval.simps derivative_def apply (simp add:insertion_sum insertion_add insertion_mult insertion_const insertion_var_zero)
        unfolding insertionp 
        unfolding insertion_simp
        unfolding b'_insertion'' a'_insertion'' 
        unfolding 
          degreeone apply simp
        unfolding a' var
        unfolding insertiona'
        using weird[OF assms(6)] by auto
    qed
  qed
qed

lemma convert_substInfinitesimalQuadratic: 
  assumes "convert_atom var At (xs'@ x#xs) = Some(At')"
  assumes "insertion (nth_default 0 (xs'@ x#xs)) a = A"
  assumes "insertion (nth_default 0 (xs'@ x#xs)) b = B"
  assumes "insertion (nth_default 0 (xs'@ x#xs)) c = C"
  assumes "insertion (nth_default 0 (xs'@ x#xs)) d = D"
  assumes "D ≠ 0"
  assumes "0 ≤ C"
  assumes "var∉(vars a)"
  assumes "var∉(vars b)"
  assumes "var∉(vars c)"
  assumes "var∉(vars d)"
  assumes "length xs' = var"
  shows "eval (substInfinitesimalQuadratic var a b c d At) (xs'@ x#xs) = evalUni (substInfinitesimalQuadraticUni A B C D At') x"
  using assms
proof(cases At)
  case (Less p)
  define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')"
  have At'_simp :  "At' = LessUni p'"
    using assms Less
    using p'_def by auto 
  show ?thesis 
    using convert_substInfinitesimalQuadratic_less[OF _ assms(2-12)]
    by (metis At'_simp Less None_eq_map_option_iff assms(1) convert_atom.simps(1) option.distinct(1) option.exhaust_sel option.the_def p'_def substInfinitesimalQuadraticUni.simps(2) substInfinitesimalQuadratic.simps(2))
next
  case (Eq p)
  define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')"
  have At'_simp :  "At' = EqUni p'"
    using assms Eq
    using p'_def by auto 
  show ?thesis 
    unfolding At'_simp Eq  substInfinitesimalQuadraticUni.simps substInfinitesimalQuadratic.simps
    using At'_simp Eq assms(1) convert_substNegInfinity assms(12) by fastforce
next
  case (Leq p)
  define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')"
  have At'_simp :  "At' = LeqUni p'"
    using assms Leq
    using p'_def by auto 
  have allzero : "eval (allZero p var) (xs'@ x#xs) = evalUni (allZero' p') x"
    using Leq assms(1) convert_allZero p'_def assms(12) by force
  have less : "eval (quadratic_sub_fm var a b c d (convertDerivative var p)) (xs'@ x#xs) = evalUni (map_atomUni (quadraticSubUni A B C D) (convertDerivativeUni p')) x"
    using convert_substInfinitesimalQuadratic_less[OF _ assms(2-12)]
    by (metis Leq assms(1) convert_atom.simps(3) option.distinct(1) option.exhaust_sel option.map(1) option.the_def p'_def)
  show ?thesis 
    unfolding At'_simp Leq substInfinitesimalQuadraticUni.simps substInfinitesimalQuadratic.simps
      eval.simps evalUni.simps
    using allzero less by auto
next
  case (Neq p)
  define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')"
  have At'_simp :  "At' = NeqUni p'"
    using assms Neq
    using p'_def by auto 
  show ?thesis 
    unfolding At'_simp Neq substInfinitesimalQuadraticUni.simps substInfinitesimalQuadratic.simps
    by (metis assms(12) At'_simp Neq assms(1) convert_substNegInfinity eval.simps(6) eval_neg substNegInfinityUni.simps(4) substNegInfinity.simps(4))
qed

lemma infinitesimal_quad_helper:
  fixes A B C D:: "real"
  assumes at_is: "At = LessUni p ∨ At = EqUni p"
  assumes "D≠0"
  assumes "C≥0"
  shows "(∃y'::real>((A+B * sqrt(C))/(D)). ∀x::real ∈{((A+B * sqrt(C))/(D))<..y'}. aEvalUni At x)
      = (evalUni (substInfinitesimalQuadraticUni A B C D At) x)"
proof(cases "At = LessUni p")
  case True
  then have LessUni: "At = LessUni p" by auto
  then show ?thesis proof(cases p)
    case (fields a b c)
    show ?thesis 
    proof(cases "2 * (a::real) * (A + B * sqrt C) / D + b = 0")
      case True
      then have True1 : "2 * a * (A + B * sqrt C) / D + b = 0" by auto
      show ?thesis proof(cases "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0")
        case True
        then have True2 : "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0" by auto
        then show ?thesis proof(cases "a<0")
          case True
          then show ?thesis unfolding LessUni fields apply (simp add:True1 True2 True)
            using True1 True2 True  
          proof - 
            assume beq: "2 * a * (A + B * sqrt C) / D + b = 0"
            assume root: "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0"
            assume alt: "a < 0 "
            let ?r = "-((A + B * sqrt C) / D)"
            have beq_var: "b = 2 * a * ?r" using beq
              by auto 
            have root_var: " a * ?r^2 - 2*a*?r*?r + c = 0" using root
              by (simp add: beq_var)
            have "∃y'>- ?r. ∀x∈{- ?r<..y'}. a * x2 + 2 * a *?r * x + c < 0" 
              using beq_var root_var alt one_root_a_lt0[where a = "a", where b="b", where c="c", where r="?r"]
              by auto
            then show "∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0"
              using beq_var by auto
          qed
        next
          case False
          then show ?thesis unfolding LessUni fields apply (simp add:True1 True2 False)
            using True1 True2 False 
          proof clarsimp 
            fix y'
            assume beq: " 2 * a * (A + B * sqrt C) / D + b = 0"
            assume root: " a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0"
            assume agteq: "¬ a < 0 "
            assume y_prop: "(A + B * sqrt C) / D < y'"
            have beq_var: "b = 2 * a * (- A - B * sqrt C) / D" using beq
              by (metis (no_types, hide_lams) ab_group_add_class.ab_diff_conv_add_uminus add.left_neutral add_diff_cancel_left' divide_inverse mult.commute mult_minus_right)             
            have root_var: " a * ((- A - B * sqrt C) / D)2 - 2 * a * (- A - B * sqrt C) * (- A - B * sqrt C) / (D * D) + c =  0"
              using root
            proof -
              have f1: "⋀r ra. - ((r::real) + ra) = - r - ra"
                by auto
              have f2: "⋀r ra. r * (a * 2 * (- A - B * sqrt C)) / (ra * D) = r / (ra / b)"
                by (simp add: beq_var)
              have f3: "c - 0 + a * ((A + B * sqrt C) / D)2 = - (b * (A + B * sqrt C) / D)"
                using root by force
              have f4: "⋀r ra rb. ((- (r::real) - ra) / rb)2 = ((r + ra) / rb)2"
                using f1 by (metis (no_types) divide_minus_left power2_minus)
              have "⋀r ra rb rc. - ((r::real) * (ra + rb) / rc) = r * (- ra - rb) / rc"
                using f1 by (metis divide_divide_eq_right divide_minus_left mult.commute)
              then show ?thesis
                using f4 f3 f2 by (simp add: mult.commute)
            qed 
            have y_prop_var: "- ((- A - B * sqrt C) / D) < y'" using y_prop
              by (metis add.commute diff_minus_eq_add divide_minus_left minus_diff_eq)
            have "∃x∈{- (- (A + B * sqrt C) / D)<..y'}. ¬ a * x2 + 2 * a * (- (A + B * sqrt C) / D) * x + c < 0"
              using y_prop_var beq_var root_var agteq one_root_a_gt0[where a = "a", where b ="b", where c = "c", where r= "-(A + B * sqrt C) / D"]
              by auto
            then show " ∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x2 + b * x + c < 0"
            proof -
              have f1: "2 * a * (A + B * sqrt C) * inverse D + b = 0"
                by (metis True1 divide_inverse)
              obtain rr :: real where
                f2: "rr ∈ {- (- (A + B * sqrt C) / D)<..y'} ∧ ¬ a * rr2 + 2 * a * (- (A + B * sqrt C) / D) * rr + c < 0"
                using ‹∃x∈{- (- (A + B * sqrt C) / D)<..y'}. ¬ a * x2 + 2 * a * (- (A + B * sqrt C) / D) * x + c < 0› by blast
              have f3: "a * ((A + B * sqrt C) * (inverse D * 2)) = - b"
                using f1 by linarith
              have f4: "∀r. - (- (r::real)) = r"
                by simp
              have f5: "∀r ra. (ra::real) * - r = r * - ra"
                by simp
              have f6: "a * ((A + B * sqrt C) * (inverse D * - 2)) = b"
                using f3 by simp
              have f7: "∀r ra rb. (rb::real) * (ra * r) = r * (rb * ra)"
                by auto
              have f8: "∀r ra. - (ra::real) * r = ra * - r"
                by linarith
              then have f9: "a * (inverse D * ((A + B * sqrt C) * - 2)) = b"
                using f7 f6 f5 by presburger
              have f10: "rr ∈ {inverse D * (A + B * sqrt C)<..y'}"
                using f4 f2 by (metis (no_types) divide_inverse mult.commute mult_minus_right)
              have "¬ c + (rr * b + a * rr2) < 0"
                using f9 f8 f7 f2 by (metis (no_types) add.commute divide_inverse mult.commute mult_minus_right)
              then show ?thesis
                using f10 by (metis (no_types) add.commute divide_inverse mult.commute)
            qed
          qed
        qed
      next
        case False
        then have False1 : "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c ≠ 0" by auto 
        show ?thesis proof(cases "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c < 0")
          case True
          show ?thesis unfolding LessUni fields apply (simp add: True1 True)
            using True1 True   
          proof -
            let ?r = "(A + B * sqrt C) / D"
            assume " 2 * a * (A + B * sqrt C) / D + b = 0"
            assume "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c < 0 "
            then have " ∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. poly [:c, b, a:] x < 0"  using continuity_lem_lt0[where r= "(A + B * sqrt C) / D", where c = "c", where b = "b", where a="a"]
                quadratic_poly_eval[of c b a ?r]  by auto
            then show "∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0"
              using quadratic_poly_eval[of c b a]
              by fastforce 
          qed
        next
          case False
          then have False' : "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c > 0" using False1 by auto
          show ?thesis unfolding LessUni fields apply(simp add: True1 False False1) 
            using True1 False' continuity_lem_gt0_expanded[where a = "a", where b = "b",where c = "c", where r = "((A + B * sqrt C) / D)"]
            by (metis mult_less_0_iff not_square_less_zero times_divide_eq_right)
        qed
      qed
    next
      case False
      then have False1 : "2 * a * (A + B * sqrt C) / D + b ≠ 0" by auto
      have c1: "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0 ⟹
    2 * a * (A + B * sqrt C) / D + b < 0 ⟹
    ∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0"
      proof -
        assume root: "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0"
        assume blt: " 2 * a * (A + B * sqrt C) / D + b < 0"
        let ?r = "-(A + B * sqrt C) / D"
        have bltvar: "b < 2 * a * ?r" using blt divide_minus_left mult_2 mult_minus_right real_add_less_0_iff
          by (metis times_divide_eq_right)
        have rootvar: "a * ?r^2 - b * ?r + c = 0" using root
        proof -
          have f1: "∀r ra. - (ra::real) * r = ra * - r"
            by simp
          have f2: "∀r ra. ((ra::real) * - r)2 = (ra * r)2"
            by simp
          have f3: "a * (inverse D * (A - B * - sqrt C))2 - inverse D * (b * - (A - B * - sqrt C)) - - c = 0"
            by (metis (no_types) diff_minus_eq_add divide_inverse mult.commute mult_minus_left root)
          have f4: "∀r ra rb. (rb::real) * (ra * r) = ra * (r * rb)"
            by simp
          have "∀r ra. (ra::real) * - r = r * - ra"
            by simp
          then have "a * (inverse D * (A - B * - sqrt C))2 - b * (inverse D * - (A - B * - sqrt C)) - - c = 0"
            using f4 f3 f1 by (metis (no_types))
          then have "a * (inverse D * - (A - B * - sqrt C))2 - b * (inverse D * - (A - B * - sqrt C)) - - c = 0"
            using f2 by presburger
          then show ?thesis
            by (simp add: divide_inverse mult.commute)
        qed
        have "∃y'> ((A + B * sqrt C) / D). ∀x∈{((A + B * sqrt C) / D)<..y'}. a * x2 + b * x + c < 0"
          using rootvar bltvar case_d1[where a= "a", where b = "b", where c = "c", where r = ?r]
          by (metis add.inverse_inverse divide_inverse mult_minus_left)
        then show ?thesis
          by blast 
      qed
      have c2: " ⋀y'. a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0 ⟹
          ¬ 2 * a * (A + B * sqrt C) / D + b < 0 ⟹
          (A + B * sqrt C) / D < y' ⟹
          ∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x2 + b * x + c < 0"
      proof - 
        let ?r = "(A + B * sqrt C) / D"
        fix y'
        assume h1: "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c = 0"
        assume h2: "¬ 2 * a * (A + B * sqrt C) / D + b < 0"
        assume h3: " (A + B * sqrt C) / D < y'"
        have eq: "2 * a * (A + B * sqrt C) / D + b = 0 ⟹ ∃x∈{(A + B * sqrt C) / D..y'}. ¬ a * x2 + b * x + c < 0"
          using False1 by blast
        have "2 * a * (A + B * sqrt C) / D + b > 0 ⟹ ∃x∈{?r<..y'}. ¬ a * x2 + b * x + c < 0" 
          using case_d4[where a = "a", where b = "b", where c= "c", where r = "-?r"] h1 h2 h3 by auto
        then show "∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x2 + b * x + c < 0" using h2 eq
          using False1 by linarith
      qed
      have c3: "((a::real) * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c < 0) ⟶
    (∃y'>((A + B * sqrt C) / D). ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0)"
      proof clarsimp 
        assume assump: "a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c < 0 "
        have "a * ((A + B * sqrt C) / D)2 + b * ((A + B * sqrt C) / D) + c < 0 ⟹
  ∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0" 
          using continuity_lem_lt0_expanded[where a= "a", where b = "b", where c = "c", where r = "((A + B * sqrt C) / D)::real"]
          by auto
        then have "∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0" using assump by auto
        then obtain y where y_prop: "y >(A + B * sqrt C) / D ∧ (∀x∈{(A + B * sqrt C) / D<..y}. a * x2 + b * x + c < 0)" by auto
        then have h: "∃ k. k >(A + B * sqrt C) / D ∧ k < y" using dense
          by blast 
        then obtain k where k_prop: "k >(A + B * sqrt C) / D  ∧ k < y" by auto
        then have "∀x∈{(A + B * sqrt C) / D..k}. a * x2 + b * x + c < 0" using y_prop
          using assump by force 
        then show "∃y'>((A + B * sqrt C) / D::real). ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c < 0"
          using k_prop by auto
      qed
      have c4: "⋀y'. a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c ≠ 0 ⟹
          ¬ a * ((A + B * sqrt C) / D)2 + b * (A + B * sqrt C) / D + c < 0 ⟹
          (A + B * sqrt C) / D < y' ⟹
          ∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x2 + b * x + c < 0"
        using continuity_lem_gt0_expanded[where a= "a", where b = "b", where c = "c", where r= "(A + B * sqrt C) / D"]
        by (metis Groups.mult_ac(1) divide_inverse less_eq_real_def linorder_not_le)
      show ?thesis unfolding LessUni fields apply(simp add: False1) 
        using c1 c2 c3 c4 by auto
    qed
  qed
next
  case False
  then have EqUni: "At = EqUni p" using at_is by auto
  then show ?thesis proof(cases p) 
    case (fields a b c) 
    have " ⋀y'. (A + B * sqrt C) / D < y' ⟹
          ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c = 0 ⟹ (a = 0 ∧ b = 0 ∧ c = 0)"
    proof -
      fix y'
      assume "(A + B * sqrt C) / D < y'"
      then show " ∀x∈{(A + B * sqrt C) / D<..y'}. a * x2 + b * x + c = 0 ⟹ (a = 0 ∧ b = 0 ∧ c = 0)" using assms continuity_lem_eq0[where r = "(A + B * sqrt C) / D", where p = "y'", where a= "a", where b ="b", where c="c"]
        by auto
    qed
    then show ?thesis
      apply (auto simp add:EqUni fields )
      using linordered_field_no_ub by blast
  qed
qed

lemma infinitesimal_quad:
  fixes A B C D:: "real"
  assumes "D≠0"
  assumes "C≥0"
  shows "(∃y'::real>((A+B * sqrt(C))/(D)). ∀x::real ∈{((A+B * sqrt(C))/(D))<..y'}. aEvalUni At x)
      = (evalUni (substInfinitesimalQuadraticUni A B C D At) x)"
proof(cases At)
  case (LessUni p)
  then show ?thesis using infinitesimal_quad_helper assms
    by blast 
next
  case (EqUni p)
  then show ?thesis
    using infinitesimal_quad_helper assms
    by blast 
next
  case (LeqUni p)
  then show ?thesis 
  proof (cases p)
    case (fields a b c) 
    have same: "∀x. aEvalUni (LeqUni p) x = (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x)" 
      apply (simp add: fields)
      by force 
    let ?r = "(A + B * sqrt C) / D"
    have "⋀a b c.
       At = LeqUni p ⟹
       p = (a, b, c) ⟹
       (∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. aEvalUni At x) =
       evalUni (substInfinitesimalQuadraticUni A B C D At) x"
    proof - 
      fix a b c
      assume atis: "At = LeqUni p"
      assume p_is: " p = (a, b, c)"
      have s1: "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x) = (∃y'>?r. ∀x∈{?r<..y'}.  (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x))"
        using atis same aEvalUni.simps(2) aEvalUni.simps(3) fields less_eq_real_def 
        by blast
      have s2: "... = (∃y'>?r. ∀x∈{?r<..y'}.  (aEvalUni (EqUni p) x)) ∨ (∃y'>?r. ∀x∈{?r<..y'}. (aEvalUni (LessUni p) x))"
        using either_or[where r = "?r"] p_is 
        by blast 
      have eq1: "(∃y'>?r. ∀x∈{?r<..y'}.  (aEvalUni (EqUni p) x)) =  (evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x)"
        using infinitesimal_quad_helper[where At = "EqUni p", where p = "p", where B = "B", where C= "C", where A= "A", where D="D"] 
          assms  by auto
      have eq2: "(∃y'>?r. ∀x∈{?r<..y'}.  (aEvalUni (LessUni p) x)) =  (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x)"
        using infinitesimal_quad_helper[where At = "LessUni p", where p = "p", where B = "B", where C= "C", where A= "A", where D="D"] 
          assms by auto
      have z1: "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x) = ((evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x))"
        using s1 s2 eq1 eq2 by auto
      have z2: "(evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x) = evalUni (substInfinitesimalQuadraticUni A B C D (LeqUni p)) x" 
        by auto
      have z3: "(evalUni (substInfinitesimalQuadraticUni A B C D At) x) = evalUni (substInfinitesimalQuadraticUni A B C D (LeqUni p)) x"
        using LeqUni by auto
      then have z4: "(evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x) = (evalUni (substInfinitesimalQuadraticUni A B C D At) x) "
        using z2 z3 by auto
      let ?a = "(evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x)"
      let ?b = "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x)"
      let ?c = "(evalUni (substInfinitesimalQuadraticUni A B C D At) x)"
      have t1: "?b = ?a" using z1 by auto
      have t2: "?a = ?c" using z4
        using atis by auto
      then have "?b = ?c" using t1 t2 by auto
      then show "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x) = evalUni (substInfinitesimalQuadraticUni A B C D At) x"
        by auto
    qed
    then show ?thesis
      using LeqUni fields by blast 
  qed
next
  case (NeqUni p)
  then show ?thesis
  proof (cases p)
    case (fields a b c) 
    then show ?thesis unfolding NeqUni fields using nonzcoeffs by auto
  qed
qed


end

Theory DNFUni

subsection "Overall General VS Proofs"
theory DNFUni
  imports QE InfinitesimalsUni
begin

fun DNFUni :: "atomUni fmUni ⇒ atomUni list list" where
  "DNFUni (AtomUni a) = [[a]]"|
  "DNFUni (TrueFUni) = [[]]" |
  "DNFUni (FalseFUni) = []"|
  "DNFUni (AndUni A B) = [A' @ B'. A' ← DNFUni A, B' ← DNFUni B]"|
  "DNFUni (OrUni A B) = DNFUni A @ DNFUni B"

lemma eval_DNFUni : "evalUni F x = evalUni (list_disj_Uni(map (list_conj_Uni o (map AtomUni)) (DNFUni F))) x"
proof(induction F)
  case TrueFUni
  then show ?case by auto
next
  case FalseFUni
  then show ?case by auto
next
  case (AtomUni x)
  then show ?case by auto
next
  case (AndUni F1 F2)
  show ?case unfolding DNFUni.simps eval_list_disj_Uni evalUni.simps AndUni List.map_concat List.set_concat apply simp
    unfolding eval_list_conj_Uni_append
    by blast
next
  case (OrUni F1 F2)
  then show ?case  unfolding DNFUni.simps List.map_append eval_list_disj_Uni List.set_append evalUni.simps
    by blast
qed

fun elimVarUni_atom :: "atomUni list ⇒ atomUni ⇒ atomUni fmUni" where
  "elimVarUni_atom F (EqUni (a,b,c)) =
(OrUni
  (AndUni 
    (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b))))
      (list_conj_Uni (map (linearSubstitutionUni b c) F)))
    (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c)))
      (OrUni 
        (list_conj_Uni (map (quadraticSubUni (-b) 1 (b^2-4*a*c) (2*a)) F))
        (list_conj_Uni (map (quadraticSubUni (-b) (-1) (b^2-4*a*c) (2*a)) F))
      )
    )
  )
)
" |
  "elimVarUni_atom F (LeqUni (a,b,c)) =
(OrUni
  (AndUni 
    (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b))))
      (list_conj_Uni (map (linearSubstitutionUni b c) F)))
    (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c)))
      (OrUni 
        (list_conj_Uni (map (quadraticSubUni (-b) 1 (b^2-4*a*c) (2*a)) F))
        (list_conj_Uni (map (quadraticSubUni (-b) (-1) (b^2-4*a*c) (2*a)) F))
      )
    )
  )
)
" |
  "elimVarUni_atom F (LessUni (a,b,c)) =
(OrUni
  (AndUni 
    (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b))))
      (list_conj_Uni (map (substInfinitesimalLinearUni b c) F)))
    (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c)))
      (OrUni 
        (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) 1 (b^2-4*a*c) (2*a)) F))
        (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) (-1) (b^2-4*a*c) (2*a)) F))
      )
    )
  )
)
"|
  "elimVarUni_atom F (NeqUni (a,b,c)) =
(OrUni
  (AndUni 
    (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b))))
      (list_conj_Uni (map (substInfinitesimalLinearUni b c) F)))
    (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c)))
      (OrUni 
        (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) 1 (b^2-4*a*c) (2*a)) F))
        (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) (-1) (b^2-4*a*c) (2*a)) F))
      )
    )
  )
)
"




fun generalVS_DNF :: "atomUni list ⇒ atomUni fmUni" where
  "generalVS_DNF L  = list_disj_Uni (list_conj_Uni(map substNegInfinityUni L) # (map (λA. elimVarUni_atom L A) L))"



end

Theory GeneralVSProofs

theory GeneralVSProofs
  imports  DNFUni EqualityVS VSAlgos
begin


fun separateAtoms :: "atomUni list ⇒ (real * real * real) list * (real * real * real) list * (real * real * real) list * (real * real * real) list" where
  "separateAtoms [] = ([],[],[],[])"|
  "separateAtoms (EqUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (p#a,b,c,d))"|
  "separateAtoms (LessUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (a,p#b,c,d))"|
  "separateAtoms (LeqUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (a,b,p#c,d))"|
  "separateAtoms (NeqUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (a,b,c,p#d))"


lemma separate_aEval :
  assumes "separateAtoms L = (a,b,c,d)"
  shows "(∀l∈set L. aEvalUni l x) = 
      ((∀(a,b,c)∈set a. a*x^2+b*x+c=0) ∧ (∀(a,b,c)∈set b. a*x^2+b*x+c<0) ∧
      (∀(a,b,c)∈set c. a*x^2+b*x+c≤0) ∧ (∀(a,b,c)∈set d. a*x^2+b*x+c≠0))"
  using assms proof(induction L arbitrary :a b c d)
  case Nil
  then show ?case by auto
next
  case (Cons At L)
  then have Cons1 : "⋀a b c d. separateAtoms L = (a, b, c, d) ⟹
    (∀l∈set L. aEvalUni l x) =
    ((∀a∈set a. case a of (a, ba, c) ⇒ a * x2 + ba * x + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ a * x2 + ba * x + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≤ 0) ∧
     (∀a∈set d. case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≠ 0))" "
    separateAtoms (At # L) = (a, b,c,d)" by auto
  then show ?case proof(cases At)
    case (LessUni p)
    show ?thesis proof(cases b)
      case Nil
      show ?thesis using Cons(2) unfolding LessUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' b')
      then have p_def : "p' = p" using Cons1(2) unfolding LessUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a,b',c,d)" using Cons Cons1(2) unfolding LessUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # b'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c < 0) = (
          (∀a∈set (b'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c < 0)∧ (case p of (a, ba, c) ⇒ a * x2 + ba * x + c < 0))"
        by auto
      have h3 : "(∀l∈set (LessUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x2 + ba * x + c < 0))"
        by auto
      show ?thesis unfolding Cons LessUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  next
    case (EqUni p)
    show ?thesis proof(cases a)
      case Nil
      show ?thesis using Cons(2) unfolding EqUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' a')
      then have p_def : "p' = p" using Cons1(2) unfolding EqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a',b,c,d)" using Cons Cons1(2) unfolding EqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c = 0) = (
          (∀a∈set (a'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c = 0)∧ (case p of (a, ba, c) ⇒ a * x2 + ba * x + c = 0))"
        by auto
      have h3 : "(∀l∈set (EqUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x2 + ba * x + c = 0))"
        by auto
      show ?thesis unfolding Cons EqUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  next
    case (LeqUni p)
    then show ?thesis proof(cases c)
      case Nil
      show ?thesis using Cons(2) unfolding LeqUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' a')
      then have p_def : "p' = p" using Cons1(2) unfolding LeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a,b,a',d)" using Cons Cons1(2) unfolding LeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≤ 0) = (
          (∀a∈set (a'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≤ 0)∧ (case p of (a, ba, c) ⇒ a * x2 + ba * x + c ≤ 0))"
        by auto
      have h3 : "(∀l∈set (LeqUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x2 + ba * x + c ≤ 0))"
        by auto
      show ?thesis unfolding Cons LeqUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  next
    case (NeqUni p)
    then show ?thesis proof(cases d)
      case Nil
      show ?thesis using Cons(2) unfolding NeqUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' a')
      then have p_def : "p' = p" using Cons1(2) unfolding NeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a,b,c,a')" using Cons Cons1(2) unfolding NeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≠ 0) = (
          (∀a∈set (a'). case a of (a, ba, c) ⇒ a * x2 + ba * x + c ≠ 0)∧ (case p of (a, ba, c) ⇒ a * x2 + ba * x + c ≠ 0))"
        by auto
      have h3 : "(∀l∈set (NeqUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x2 + ba * x + c ≠ 0))"
        by auto
      show ?thesis unfolding Cons NeqUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  qed
qed

lemma splitAtoms_negInfinity :
  assumes "separateAtoms L = (a,b,c,d)"
  shows "(∀l∈set L. evalUni (substNegInfinityUni l) x) = (
  (∀(a,b,c)∈set a.(∃x. ∀y<x. a*y^2+b*y+c=0))∧
  (∀(a,b,c)∈set b.(∃x. ∀y<x. a*y^2+b*y+c<0))∧
  (∀(a,b,c)∈set c.(∃x. ∀y<x. a*y^2+b*y+c≤0))∧
  (∀(a,b,c)∈set d.(∃x. ∀y<x. a*y^2+b*y+c≠0)))"
  using assms proof(induction L arbitrary :a b c d)
  case Nil
  then show ?case by auto
next
  case (Cons At L)
  then have Cons1 : "⋀a b c d. separateAtoms L = (a, b, c, d) ⟹
    (∀l∈set L. evalUni (substNegInfinityUni l) x) =
    ((∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))" "separateAtoms (At # L) = (a, b, c, d)" by auto
  then show ?case proof(cases At)
    case (LessUni p)
    show ?thesis using LessUni Cons proof(induction b rule : list.induct)
      case Nil
      then have Nil : "b = []"
        using Cons.prems by auto
      show ?case using Cons(2) unfolding LessUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' b')
      then have p_def : "p' = p" using Cons1(2) unfolding LessUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a,b',c,d)" using Cons Cons1(2) unfolding LessUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # b'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0) = (
          (∀a∈set ( b'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0))"
        by auto
      have one: "(∃x. ∀y<x. aEvalUni (LessUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)"
        apply(cases p) by simp
      have "(∀l∈set (LessUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (LessUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))"
        by auto
      also have "... = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
      (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))"
        unfolding infinity_evalUni[of "LessUni p" x, symmetric] Cons(3)[OF h1]  LessUni one by simp
      finally have h3 : "(∀l∈set (LessUni p # L). evalUni (substNegInfinityUni l) x) = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
      (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0) )"
        by auto
      show ?case unfolding Cons LessUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  next
    case (EqUni p)
    show ?thesis using EqUni Cons proof(induction a rule : list.induct)
      case Nil
      then have Nil : "a = []"
        using Cons.prems by auto
      show ?case using Cons(2) unfolding EqUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' a')
      then have p_def : "p' = p" using Cons1(2) unfolding EqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a',b,c,d)" using Cons Cons1(2) unfolding EqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) = (
          (∀a∈set ( a'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0))"
        by auto
      have one: "(∃x. ∀y<x. aEvalUni (EqUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0)"
        apply(cases p) by simp
      have "(∀l∈set (EqUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (EqUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))"
        by auto
      also have "... = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0)∧
      (∀a∈set a'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))"
        unfolding infinity_evalUni[of "EqUni p" x, symmetric] Cons(3)[OF h1] EqUni one by simp
      finally have h3 : "(∀l∈set (EqUni p # L). evalUni (substNegInfinityUni l) x) = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0)∧
      (∀a∈set a'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))"
        by auto
      show ?case unfolding Cons EqUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  next
    case (LeqUni p)
    show ?thesis using LeqUni Cons proof(induction c rule : list.induct)
      case Nil
      then have Nil : "c = []"
        using Cons.prems by auto
      show ?case using Cons(2) unfolding LeqUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' c')
      then have p_def : "p' = p" using Cons1(2) unfolding LeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a,b,c',d)" using Cons Cons1(2) unfolding LeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # c'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0) = (
          (∀a∈set ( c'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0))"
        by auto
      have one: "(∃x. ∀y<x. aEvalUni (LeqUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)"
        apply(cases p) by simp
      have "(∀l∈set (LeqUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (LeqUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))"
        by auto
      also have "... = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
      (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))"
        unfolding infinity_evalUni[of "LeqUni p" x, symmetric] Cons(3)[OF h1]  LeqUni one 
        by simp
      finally have h3 : "(∀l∈set (LeqUni p # L). evalUni (substNegInfinityUni l) x) = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
      (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0) )"
        by auto
      show ?case unfolding Cons LeqUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  next
    case (NeqUni p)
    show ?thesis using NeqUni Cons proof(induction d rule : list.induct)
      case Nil
      then have Nil : "d = []"
        using Cons.prems by auto
      show ?case using Cons(2) unfolding NeqUni separateAtoms.simps Nil
        apply(cases "separateAtoms L") by simp
    next
      case (Cons p' d')
      then have p_def : "p' = p" using Cons1(2) unfolding NeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h1 :  "separateAtoms L = (a,b,c,d')" using Cons Cons1(2) unfolding NeqUni separateAtoms.simps
        apply(cases "separateAtoms L") by simp
      have h2 : "(∀a∈set (p # d'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0) = (
          (∀a∈set ( d'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))"
        by auto
      have one: "(∃x. ∀y<x. aEvalUni (NeqUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0)"
        apply(cases p) by simp
      have "(∀l∈set (NeqUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (NeqUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))"
        by auto
      also have "... = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0)∧
      (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0))"
        unfolding infinity_evalUni[of "NeqUni p" x, symmetric] Cons(3)[OF h1]  NeqUni one 
        by simp
      finally have h3 : "(∀l∈set (NeqUni p # L). evalUni (substNegInfinityUni l) x) = (
      (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0)∧
      (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c = 0) ∧
     (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c < 0)∧
     (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≤ 0)∧
     (∀a∈set d'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y2 + ba * y + c ≠ 0) )"
        by auto
      show ?case unfolding Cons NeqUni p_def h2 h3 using Cons1(1)[OF h1]
        by auto
    qed
  qed
qed

lemma set_split : 
  assumes "separateAtoms L = (eq,les,leq,neq)"
  shows "set L = set (map EqUni eq @ map LessUni les @ map LeqUni leq @ map NeqUni neq)"
  using assms proof(induction L arbitrary :eq les leq neq)
  case Nil
  then show ?case by auto
next
  case (Cons At L)
  then show ?case proof(cases At)
    case (LessUni p)
    have "∃les'. p#les' = les ∧ separateAtoms L = (eq, les', leq, neq)" using Cons(2) unfolding LessUni apply (cases "separateAtoms L") by auto
    then obtain les' where les' : "p#les' = les" "separateAtoms L = (eq, les', leq, neq)" by auto
    show ?thesis unfolding LessUni les'(1)[symmetric] using Cons(1)[OF les'(2)] by auto
  next
    case (EqUni p)
    have "∃eq'. p#eq' = eq ∧ separateAtoms L = (eq', les, leq, neq)" using Cons(2) unfolding EqUni apply (cases "separateAtoms L") by auto
    then obtain eq' where eq' : "p#eq' = eq" "separateAtoms L = (eq', les, leq, neq)" by auto
    show ?thesis unfolding EqUni eq'(1)[symmetric] using Cons(1)[OF eq'(2)] by auto
  next
    case (LeqUni p)
    have "∃leq'. p#leq' = leq ∧ separateAtoms L = (eq, les, leq', neq)" using Cons(2) unfolding LeqUni apply (cases "separateAtoms L")
      by auto
    then obtain leq' where leq' : "p#leq' = leq" "separateAtoms L = (eq, les, leq', neq)" by auto
    show ?thesis unfolding LeqUni leq'(1)[symmetric] using Cons(1)[OF leq'(2)] by auto
  next
    case (NeqUni p)
    have "∃neq'. p#neq' = neq ∧ separateAtoms L = (eq, les, leq, neq')" using Cons(2) unfolding NeqUni apply (cases "separateAtoms L")
      by auto
    then obtain neq' where neq' : "p#neq' = neq" "separateAtoms L = (eq, les, leq, neq')" by auto
    show ?thesis unfolding NeqUni neq'(1)[symmetric] using Cons(1)[OF neq'(2)] by auto
  qed
qed

lemma set_split' : assumes "separateAtoms L = (eq,les,leq,neq)"
  shows "set (map P L) = set (map (P o EqUni) eq @ map (P o LessUni) les @ map (P o LeqUni) leq @ map (P o NeqUni) neq)"
  unfolding image_set[symmetric] set_split[OF assms]
  unfolding image_set map_append map_map by auto

lemma split_elimVar :
  assumes "separateAtoms L = (eq,les,leq,neq)"
  shows "(∃l∈set L. evalUni (elimVarUni_atom L' l) x) = 
  ((∃(a',b',c')∈set eq. (evalUni (elimVarUni_atom L' (EqUni(a',b',c'))) x))
  ∨ (∃(a',b',c')∈set les. 
    (evalUni (elimVarUni_atom L' (LessUni(a',b',c'))) x))
∨ (∃(a',b',c')∈set leq. 
    (evalUni (elimVarUni_atom L' (LeqUni(a',b',c'))) x))
∨ (∃(a',b',c')∈set neq. 
    (evalUni (elimVarUni_atom L' (NeqUni(a',b',c'))) x)))"
proof-
  have c1: "(∃l∈set eq. evalUni (elimVarUni_atom L' (EqUni l)) x) = (∃(a', b', c')∈set eq. evalUni (elimVarUni_atom L' (EqUni (a', b', c'))) x)"
    by (metis (no_types, lifting) case_prodE case_prodI2)
  have c2: "(∃l∈set les. evalUni (elimVarUni_atom L' (LessUni l)) x) = (∃(a', b', c')∈set les. evalUni (elimVarUni_atom L' (LessUni (a', b', c'))) x)"
    by (metis (no_types, lifting) case_prodE case_prodI2)
  have c3: "(∃l∈set leq. evalUni (elimVarUni_atom L' (LeqUni l)) x) = (∃(a', b', c')∈set leq. evalUni (elimVarUni_atom L' (LeqUni (a', b', c'))) x)"
    by (metis (no_types, lifting) case_prodE case_prodI2)
  have c4: "(∃l∈set neq. evalUni (elimVarUni_atom L' (NeqUni l)) x) = (∃(a', b', c')∈set neq. evalUni (elimVarUni_atom L' (NeqUni (a', b', c'))) x)"
    by (metis (no_types, lifting) case_prodE case_prodI2)
  have h :  "((∃l∈EqUni ` set eq. evalUni (elimVarUni_atom L' l) x) ∨
         (∃l∈LessUni ` set les. evalUni (elimVarUni_atom L' l) x) ∨
    (∃l∈LeqUni ` set leq. evalUni (elimVarUni_atom L' l) x) ∨
    (∃l∈NeqUni ` set neq. evalUni (elimVarUni_atom L' l) x)
    ) = 
        ((∃l∈set eq. evalUni (elimVarUni_atom L' (EqUni l)) x) ∨
         (∃l∈set les. evalUni (elimVarUni_atom L' (LessUni l)) x) ∨
    (∃l∈set leq. evalUni (elimVarUni_atom L' (LeqUni l)) x) ∨
    (∃l∈set neq. evalUni (elimVarUni_atom L' (NeqUni l)) x)
    )"
    by auto
  then have "... = ((∃(a', b', c')∈set eq. evalUni (elimVarUni_atom L' (EqUni (a', b', c'))) x) ∨
     (∃(a', b', c')∈set les. evalUni (elimVarUni_atom L' (LessUni (a', b', c'))) x) ∨
     (∃(a', b', c')∈set leq. evalUni (elimVarUni_atom L' (LeqUni (a', b', c'))) x) ∨
     (∃(a', b', c')∈set neq. evalUni (elimVarUni_atom L' (NeqUni (a', b', c'))) x))"
    using c1 c2 c3 c4 by auto
  then show ?thesis 
    unfolding set_split[OF assms] set_append bex_Un image_set[symmetric]
    using case_prodE case_prodI2  by auto
qed

lemma split_elimvar : 
  assumes "separateAtoms L = (eq,les,leq,neq)"
  shows "evalUni (elimVarUni_atom L At) x = evalUni (elimVarUni_atom ((map EqUni eq)@(map LessUni les) @ map LeqUni leq @ map NeqUni neq) At) x"
proof(cases At)
  case (LessUni p)
  then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp
next
  case (EqUni p)
  then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp
next
  case (LeqUni p)
  then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp
next
  case (NeqUni p)
  then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp
qed




lemma less : "
         ((a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a. evalUni (substInfinitesimalLinearUni b' c' (EqUni (d, e, f))) x) ∧
         (∀(d, e, f)∈set b. evalUni (substInfinitesimalLinearUni b' c' (LessUni (d, e, f))) x) ∧
         (∀(d, e, f)∈set c. evalUni (substInfinitesimalLinearUni b' c' (LeqUni (d, e, f))) x) ∧
         (∀(d, e, f)∈set d. evalUni (substInfinitesimalLinearUni b' c' (NeqUni (d, e, f))) x) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              evalUni
               (substInfinitesimalQuadraticUni (- b') 1 (b'2 - 4 * a' * c') (2 * a')
                 (EqUni (d, e, f)))
               x) ∧
          (∀(d, e, f)∈set b.
              evalUni
               (substInfinitesimalQuadraticUni (- b') 1 (b'2 - 4 * a' * c') (2 * a')
                 (LessUni (d, e, f)))
               x) ∧
          (∀(d, e, f)∈set c.
              evalUni
               (substInfinitesimalQuadraticUni (- b') 1 (b'2 - 4 * a' * c') (2 * a')
                 (LeqUni (d, e, f)))
               x) ∧
          (∀(d, e, f)∈set d.
              evalUni
               (substInfinitesimalQuadraticUni (- b') 1 (b'2 - 4 * a' * c') (2 * a')
                 (NeqUni (d, e, f)))
               x) ∨
          (∀(d, e, f)∈set a.
              evalUni
               (substInfinitesimalQuadraticUni (- b') (- 1) (b'2 - 4 * a' * c') (2 * a')
                 (EqUni (d, e, f)))
               x) ∧
          (∀(d, e, f)∈set b.
              evalUni
               (substInfinitesimalQuadraticUni (- b') (- 1) (b'2 - 4 * a' * c') (2 * a')
                 (LessUni (d, e, f)))
               x) ∧
          (∀(d, e, f)∈set c.
              evalUni
               (substInfinitesimalQuadraticUni (- b') (- 1) (b'2 - 4 * a' * c') (2 * a')
                 (LeqUni (d, e, f)))
               x) ∧
          (∀(d, e, f)∈set d.
              evalUni
               (substInfinitesimalQuadraticUni (- b') (- 1) (b'2 - 4 * a' * c') (2 * a')
                 (NeqUni (d, e, f)))
               x))) = 

          ((a' = 0 ∧ b' ≠ 0) ∧
         (∀(d, e, f)∈set a.
             (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (EqUni (d, e, f)) x)) ∧
         (∀(d, e, f)∈set b.
            (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (LessUni (d, e, f)) x))∧
         (∀(d, e, f)∈set c.
             (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (LeqUni (d, e, f)) x)) ∧
         (∀(d, e, f)∈set d.
            (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (NeqUni (d, e, f)) x)) ∨
         a' ≠ 0 ∧
         - b'2 + 4 * a' * c' ≤ 0 ∧
         ((∀(d, e, f)∈set a.
              (∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (EqUni (d,e,f)) x)) ∧
          (∀(d, e, f)∈set b.
              (∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (LessUni (d,e,f)) x)) ∧
          (∀(d, e, f)∈set c.
              (∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (LeqUni (d,e,f)) x)) ∧
          (∀(d, e, f)∈set d.
              (∃y'>(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (NeqUni (d,e,f)) x)) ∨
          (∀(d, e, f)∈set a.
              (∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (EqUni (d,e,f)) x)) ∧
          (∀(d, e, f)∈set b.
              (∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (LessUni (d,e,f)) x)) ∧ 
          (∀(d, e, f)∈set c.
              (∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (LeqUni (d,e,f)) x)) ∧
          (∀(d, e, f)∈set d.
              (∃y'>(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a').
        ∀x∈{(- b' + - 1 * sqrt (b'2 - 4 * a' * c')) / (2 * a')<..y'}.
           aEvalUni (NeqUni (d,e,f)) x))))"
proof(cases "a'=0")
  case True
  then have a' :  "a'=0" by auto
  then show ?thesis proof(cases "b'=0")
    case True
    then show ?thesis using a' by auto
  next
    case False
    then show ?thesis using True unfolding infinitesimal_linear'[of b' c' _ x, symmetric, OF False] by auto
  qed 
next
  case False
  then have a' : "a' ≠ 0" by auto
  then have d : "2 * a' ≠ 0" by auto
  show ?thesis proof(cases "0 ≤ b'2 - 4 * a' * c'")
    case True
    then show ?thesis using False
      unfolding infinitesimal_quad[OF d True, of "-b'", symmetric] by auto
  next
    case False
    then show ?thesis using a' by auto
  qed 
qed

lemma eq_inf : "(∀(a, b, c)∈set (a::(real*real*real) list). ∃x. ∀y<x. a * y2 + b * y + c = 0) = (∀(a, b, c)∈set a. a=0∧b=0∧c=0)"
  using infinity_evalUni_EqUni[of _ x] by auto



text "This is the main quantifier elimination lemma, in the simplified framework. We are located directly underneath 
the most internal existential quantifier so F is completely free in quantifier and consists only of conjunction and disjunction.
The variable we are evaluating on, x, is removed in the generalVS\\_DNF converted formula as expanding out the evalUni function
determines that x doesn't play a role in the computation of it. It would be okay to replace the x in the second half with any variable,
but it is simplier this way

This conversion is defined as a \"veritcal\" translation as we remain within the univariate framework in both sides of the expression"

lemma eval_generalVS'' : "(∃x. evalUni (list_conj_Uni (map AtomUni L)) x) =
                               evalUni (generalVS_DNF L) x"
proof(cases "separateAtoms L")
  case (fields a b c d)
  have a : "⋀ P. (∀l∈set (map EqUni a) ∪ (set (map LessUni b) ∪ (set (map LeqUni c) ∪ set (map NeqUni d))).P l) = 
            ((∀(d,e,f)∈set a. P (EqUni (d,e,f))) ∧ (∀(d,e,f)∈set b. P (LessUni (d,e,f))) ∧ (∀(d,e,f)∈set c. P (LeqUni (d,e,f))) ∧ (∀(d,e,f)∈set d. P (NeqUni (d,e,f))))"
    by auto
  show ?thesis apply(simp add: eval_list_conj_Uni separate_aEval[OF fields]
        splitAtoms_negInfinity[OF fields] eval_list_disj_Uni 
        del:elimVar.simps)

    unfolding eval_conj_atom generalVS_DNF.simps 
      split_elimVar[OF fields ] 

split_elimvar[OF fields]

    unfolding elimVarUni_atom.simps evalUni.simps aEvalUni.simps
      Rings.mult_zero_class.mult_zero_left Groups.add_0 eval_list_conj_Uni Groups.group_add_class.minus_zero 
      eval_map_all linearSubstitutionUni.simps quadraticSubUni.simps evalUni_if aEvalUni.simps
      set_append a less eq_inf
    using qe  by auto
qed


lemma forallx_substNegInf : "(¬evalUni (map_atomUni substNegInfinityUni F) x) = (∀x. ¬ evalUni (map_atomUni substNegInfinityUni F) x)"
proof(induction F)
  case TrueFUni
  then show ?case by simp
next
  case FalseFUni
  then show ?case  by simp
next
  case (AtomUni At)
  then show ?case apply(cases At) by auto  
next
  case (AndUni F1 F2)
  then show ?case  by auto
next
  case (OrUni F1 F2)
  then show ?case  by auto
qed

lemma linear_subst_map: "evalUni (map_atomUni (linearSubstitutionUni b c) F) x = evalUni F (-c/b)"
  apply(induction F)by auto

lemma quadratic_subst_map : "evalUni (map_atomUni (quadraticSubUni a b c d) F) x = evalUni F ((a+b*sqrt(c))/d)"
  apply(induction F)by auto




fun convert_atom_list :: "nat ⇒ atom list ⇒ real list ⇒ (atomUni list) option" where
  "convert_atom_list var [] xs = Some []"|
  "convert_atom_list var (a#as) xs = (
  case convert_atom var a xs of Some(a) ⇒ 
  (case convert_atom_list var as xs of Some(as) ⇒ Some(a#as) | None ⇒ None)
   | None ⇒ None
)"





lemma convert_atom_list_change :
  assumes "length xs' = var"
  shows "convert_atom_list var L (xs' @ x # Γ) = convert_atom_list var L (xs' @ x' # Γ)"
  apply(induction L)using convert_atom_change[OF assms] apply simp_all
  by (metis)

lemma negInf_convert :
  assumes "convert_atom_list var L (xs' @ x # xs) = Some L'"
  assumes "length xs' = var"
  shows "(∀f∈set L. eval (substNegInfinity var f) (xs' @ x # xs))
         = (∀f∈set L'. evalUni (substNegInfinityUni f) x)"
  using assms
proof(induction L arbitrary : L')
  case Nil
  then show ?case by auto
next
  case (Cons a L)
  then show ?case proof(cases a)
    case (Less p)
    have h:  "MPoly_Type.degree p var < 3 ⟹
          eval (substNegInfinity var (Less p)) (xs' @ x # xs) = evalUni
           (substNegInfinityUni
             (LessUni
               (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0))))
           x"
      using convert_substNegInfinity[of var "Less p" xs' x xs, OF _ assms(2)] by simp
    show ?thesis using Cons(2)[symmetric] Cons(1) unfolding Less apply(cases " MPoly_Type.degree p var < 3")
      defer apply simp apply(cases "convert_atom_list var L (xs' @ x # xs)") apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps)
      unfolding h
      using assms(2) by presburger
  next
    case (Eq p)
    have h:  "MPoly_Type.degree p var < 3 ⟹
          eval (substNegInfinity var (Eq p)) (xs' @ x # xs) = evalUni
           (substNegInfinityUni
             (EqUni
               (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0))))
           x"
      using convert_substNegInfinity[of var "Eq p", OF _ assms(2)] by simp
    show ?thesis using Cons(2)[symmetric] Cons(1) unfolding Eq apply(cases " MPoly_Type.degree p var < 3")
      defer apply simp apply(cases "convert_atom_list var L (xs' @ x # xs)") apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps)
      unfolding h assms by auto
  next
    case (Leq p)
    have h:  "MPoly_Type.degree p var < 3 ⟹
          eval (substNegInfinity var (Leq p)) (xs' @ x # xs) = evalUni
           (substNegInfinityUni
             (LeqUni
               (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0))))
           x"
      using convert_substNegInfinity[of var "Leq p", OF _ assms(2)] by simp
    show ?thesis using Cons(2) unfolding Leq apply(cases " MPoly_Type.degree p var < 3") 
      defer apply simp 
      apply(cases "convert_atom_list var L (xs' @ x # xs)") 
      apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps)
      unfolding h using Cons.IH assms by auto 
  next
    case (Neq p)
    have h:  "MPoly_Type.degree p var < 3 ⟹
          eval (substNegInfinity var (Neq p)) (xs' @ x # xs) = evalUni
           (substNegInfinityUni
             (NeqUni
               (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)),
                insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0))))
           x"
      using convert_substNegInfinity[of var "Neq p", OF _ assms(2)] by simp
    show ?thesis using Cons(2) unfolding Neq apply(cases " MPoly_Type.degree p var < 3") defer apply simp 
      apply(cases "convert_atom_list var L (xs' @ x # xs)") 
      apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps)
      unfolding h using Cons.IH assms by auto
  qed
qed

lemma elimVar_atom_single :
  assumes "convert_atom var A (xs' @ x # xs) = Some A'"
  assumes "convert_atom_list var L2 (xs' @ x # xs) = Some L2'"
  assumes "length xs' = var"
  shows "eval (elimVar var L2 [] A) (xs' @ x # xs) = evalUni (elimVarUni_atom L2' A') x"
proof(cases A)
  case (Less p)
  define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)"
  have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def
    using insertion_isovarspars_free[of "(xs' @ x # xs)" var x p 2 0] assms by auto
  define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))"
  have b_def' : "b = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def
    using insertion_isovarspars_free[of "(xs' @ x # xs)" var x p "(Suc 0)" 0] assms by auto
  define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)"
  have c_def' : "c = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def
    using insertion_isovarspars_free[of "(xs' @ x # xs)" var x p 0 0] assms by auto
  have linear : "b≠0 ⟹ (∀f∈set L2.
         eval
          (substInfinitesimalLinear var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
          (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalLinearUni b c l) x)"
    using assms(2) proof(induction L2 arbitrary : L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(3) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(3) At'
      by (simp_all add: L2's)
    have h : "eval
         (substInfinitesimalLinear var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0))
            At)
         (xs' @ x # xs) = evalUni (substInfinitesimalLinearUni b c At') x"
    proof(cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At)  by simp_all
    next
      case (Some a)
      have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))"
        by (simp add: not_in_isovarspar) 
      have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) 
      have h :  "evalUni (substInfinitesimalLinearUni b c a) x =
    evalUni (substInfinitesimalLinearUni b c At') x"
      proof(cases At)
        case (Less p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Eq p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Leq x3)
        then show ?thesis using At' Some by auto 
      next
        case (Neq x4)
        then show ?thesis using At' Some by auto 
      qed
      show ?thesis unfolding convert_substInfinitesimalLinear[OF Some b_def[symmetric] c_def[symmetric] Cons(2) h1 h2 assms(3)]
        using h .
    qed
    show ?case unfolding L2' using h Cons(1)[OF Cons(2) L2's] by auto
  qed
  have quadratic_1 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹ (∀f∈set L2.
          eval
           (substInfinitesimalQuadratic var
             (- isolate_variable_sparse p var (Suc 0)) 1
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni
           (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) l)
           x)"
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(1::real mpoly)"
      by (metis h9 not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
      (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) 1
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
        (2 * isolate_variable_sparse p var 2) At)
      (xs' @ x # xs) =  evalUni
      (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) At') x"
    proof (cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by auto
    next
      case (Some aT)
      have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto
      have h2 : "insertion (nth_default 0 (xs' @ x # xs)) 1 = 1" by auto
      have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b2 - 4 * a * c)"
        unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def
        by auto
      have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a"
        unfolding insertion_mult a_def
        by (metis insertion_add insertion_mult mult_2)
      have h5 : "2 * a ≠ 0" using Cons by auto
      have h6 : "0 ≤ b2 - 4 * a * c" using Cons by auto
      have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
        by (simp add: not_in_isovarspar not_in_neg)
      have h8 : "var∉vars(1::real mpoly)"
        by (metis h9 not_in_pow power.simps(1))
      have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))2 -
             4 * isolate_variable_sparse p var 2 *
             isolate_variable_sparse p var 0)"
        by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
      have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)"
        by (metis isovarspar_sum mult_2 not_in_isovarspar)
      have h : "evalUni (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) aT)
     x =
    evalUni (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) At')
     x"proof(cases At)
        case (Less p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Eq p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Leq x3)
        then show ?thesis using At' using Some by auto
      next
        case (Neq x4)
        then show ?thesis using At' using Some by auto 
      qed
      show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)]
        using h .
    qed


    show ?case
      unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h
      by auto
  qed
  have quadratic_2 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹ (∀f∈set L2.
          eval
           (substInfinitesimalQuadratic var
             (- isolate_variable_sparse p var (Suc 0)) (- 1)
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni
           (substInfinitesimalQuadraticUni (- b) (- 1) (b2 - 4 * a * c) (2 * a)
             l)
           x)" 
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = (-1)" unfolding insertion_neg by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) using assms
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto using assms
      by (metis (no_types, hide_lams) MPoly_Type.insertion_one add.inverse_inverse add_uminus_conv_diff arith_special(3) insertion_isovarspars_free insertion_neg insertion_sub list_update_id) 
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(- 1::real mpoly)"
      by (metis h9 not_in_neg not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
      (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) (-1)
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
        (2 * isolate_variable_sparse p var 2) At)
      (xs' @ x # xs) =  evalUni
      (substInfinitesimalQuadraticUni (- b) (-1) (b2 - 4 * a * c) (2 * a) At') x"
    proof (cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by auto
    next
      case (Some aT)
      have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto
      have h2 : "insertion (nth_default 0 (xs' @ x # xs)) (-1) = -1" unfolding insertion_neg by auto
      have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b2 - 4 * a * c)"
        unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def using assms
        by auto
      have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a"
        unfolding insertion_mult a_def
        by (metis insertion_add insertion_mult mult_2)
      have h5 : "2 * a ≠ 0" using Cons by auto
      have h6 : "0 ≤ b2 - 4 * a * c" using Cons by auto
      have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
        by (simp add: not_in_isovarspar not_in_neg)
      have h8 : "var∉vars(- 1::real mpoly)"
        by (simp add: h10 not_in_neg)
      have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))2 -
             4 * isolate_variable_sparse p var 2 *
             isolate_variable_sparse p var 0)"
        by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
      have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)"
        by (metis isovarspar_sum mult_2 not_in_isovarspar)
      have h : "evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b2 - 4 * a * c) (2 * a) aT)
     x =
    evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b2 - 4 * a * c) (2 * a) At')
     x"proof(cases At)
        case (Less p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Eq p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Leq x3)
        then show ?thesis using At'
          using Some option.inject by auto 
      next
        case (Neq x4)
        then show ?thesis using At'
          using Some by auto 
      qed
      show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)]
        using h .
    qed


    show ?case
      unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h
      by auto
  qed

  show ?thesis using assms(1)[symmetric] unfolding Less apply(cases "MPoly_Type.degree p var < 3") apply simp_all
    apply(simp del : substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps
        add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four
        a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj
        eval_list_conj_Uni
        ) using linear quadratic_1 quadratic_2 by smt
next
  case (Eq p)
  define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)"
  have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def
    using insertion_isovarspars_free[of "xs' @x#xs" var x p 2 0] using assms by auto
  define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))"
  have b_def' : "b = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def
    using insertion_isovarspars_free[of "xs' @x#xs" var x p "(Suc 0)" 0] using assms by auto
  define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)"
  have c_def' : "c = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def
    using insertion_isovarspars_free[of "xs' @x#xs" var x p 0 0]using assms by auto
  have linear : "a=0 ⟹ b≠0 ⟹ (∀f∈set L2.
         aEval
          (linear_substitution var 
            (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
          (xs' @ x # xs)) = (∀l∈set L2'. evalUni (linearSubstitutionUni b c l) x)"

    using assms(2)
  proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar) 
    have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) 
    have h : "aEval
         (linear_substitution var
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At)
         (xs' @ x # xs) = evalUni (linearSubstitutionUni b c At') x"
    proof(cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by auto
    next
      case (Some a)
      have h : "a=At'"
        using At' Some by auto
      show ?thesis unfolding convert_linearSubstitutionUni[OF Some b_def[symmetric] c_def[symmetric] Cons(3) h1 h2 assms(3)] 
        unfolding h by auto
    qed 
    have "(∀f∈set (At # L2).
        aEval
         (linear_substitution var
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
         (xs' @ x # xs)) = (aEval
         (linear_substitution var 
           (-isolate_variable_sparse p var 0)(isolate_variable_sparse p var (Suc 0)) At)
         (xs' @ x # xs)∧ (∀f∈set (L2).
        aEval
         (linear_substitution var
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
         (xs' @ x # xs)))" by auto
    also have "... = (evalUni (linearSubstitutionUni b c At') x ∧
     (∀l∈set L2's. evalUni (linearSubstitutionUni b c l) x))"
      unfolding h Cons(1)[OF Cons(2) Cons(3) L2's]  by auto
    finally show ?case   unfolding L2' by auto
  qed

  have quadratic_1 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹(∀f∈set L2.
          eval
           (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni (quadraticSubUni (- b) 1 (b2 - 4 * a * c) (2 * a) l) x)"
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_add insertion_isovarspars_free insertion_mult list_update_length mult_2)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(1::real mpoly)"
      by (metis h9 not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
     (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1
       ((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
       (2 * isolate_variable_sparse p var 2) At)
     (xs' @ x # xs) =  aEval At (xs' @ (((- b + 1 * sqrt (b2 - 4 * a * c)) / (2 * a)) # xs))"
      using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At]
        free_in_quad[OF h9 h10 h4 h11]
      by (metis assms(3) list_update_length var_not_in_eval3) 
    have h2 : "aEval At (xs' @ (- b + 1 * sqrt (b2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) 1 (b2 - 4 * a * c) (2 * a) At') x"
    proof(cases At)
      case (Less p)
      then show ?thesis
      proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Less apply(cases "MPoly_Type.degree p var < 3")  by simp_all
      qed
    next
      case (Eq p)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Eq apply(cases "MPoly_Type.degree p var < 3")  by simp_all
      qed
    next
      case (Leq x3)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    next
      case (Neq x4)
      then show ?thesis 
      proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    qed
    show ?case
      unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h h2
      by auto
  qed
  have quadratic_2 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹ (∀f∈set L2.
          eval
           (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (- 1)
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni (quadraticSubUni (- b) (- 1) (b2 - 4 * a * c) (2 * a) l) x)"
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" using assms by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = -1"
      unfolding insertion_neg
      by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(-1::real mpoly)"
      by (metis h9 not_in_neg not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
     (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1)
       ((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
       (2 * isolate_variable_sparse p var 2) At)
     (xs' @ x # xs) =  aEval At (xs' @ (((- b - 1 * sqrt (b2 - 4 * a * c)) / (2 * a)) # xs))"
      using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At]
        var_not_in_eval3 free_in_quad[OF h9 h10 h4 h11]
      using assms(3) by fastforce 
    have h2 : "aEval At (xs'  @ (- b - 1 * sqrt (b2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) (-1) (b2 - 4 * a * c) (2 * a) At') x"
    proof(cases At)
      case (Less p)
      then show ?thesis
      proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Less apply(cases "MPoly_Type.degree p var < 3")  by simp_all
      qed
    next
      case (Eq p)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all
      qed
    next
      case (Leq x3)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    next
      case (Neq x4)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    qed
    show ?case
      unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h h2
      by auto
  qed
  show ?thesis using assms(1)[symmetric] unfolding Eq apply(cases "MPoly_Type.degree p var < 3") apply simp_all
    apply(simp del : linearSubstitutionUni.simps quadraticSubUni.simps
        add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four
        a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj
        eval_list_conj_Uni )using linear
    using quadratic_1 quadratic_2
    by smt
next
  case (Leq p)
  define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)"
  have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def
    using insertion_isovarspars_free[of "xs'@ x#xs" var x p 2 0] using assms by auto
  define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))"
  have b_def' : "b = insertion (nth_default 0 (xs'@ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def
    using insertion_isovarspars_free[of "xs'@x#xs" var x p "(Suc 0)" 0] using assms by auto
  define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)"
  have c_def' : "c = insertion (nth_default 0 (xs'@ 0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def
    using insertion_isovarspars_free[of "xs'@ x#xs" var x p 0 0] using assms by auto
  have linear : "a=0 ⟹ b≠0 ⟹ (∀f∈set L2.
         aEval
          (linear_substitution var 
            (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
          (xs' @ x # xs)) = (∀l∈set L2'. evalUni (linearSubstitutionUni b c l) x)"
    using assms(2)
  proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar) 
    have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) 
    have h : "aEval
         (linear_substitution var 
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At)
         (xs' @ x # xs) = evalUni (linearSubstitutionUni b c At') x"
    proof(cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by auto
    next
      case (Some a)
      have h : "a=At'"
        using At' Some by auto
      show ?thesis unfolding convert_linearSubstitutionUni[OF Some b_def[symmetric] c_def[symmetric] Cons(3) h1 h2 assms(3)] 
        unfolding h by auto
    qed 
    have "(∀f∈set (At # L2).
        aEval
         (linear_substitution var 
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
         (xs' @ x # xs)) = (aEval
         (linear_substitution var 
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At)
         (xs' @ x # xs)∧ (∀f∈set (L2).
        aEval
         (linear_substitution var 
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
         (xs' @ x # xs)))" by auto
    also have "... = (evalUni (linearSubstitutionUni b c At') x ∧
     (∀l∈set L2's. evalUni (linearSubstitutionUni b c l) x))"
      unfolding h Cons(1)[OF Cons(2) Cons(3) L2's]  by auto
    finally show ?case   unfolding L2' by auto
  qed

  have quadratic_1 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹(∀f∈set L2.
          eval
           (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni (quadraticSubUni (- b) 1 (b2 - 4 * a * c) (2 * a) l) x)"
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(1::real mpoly)"
      by (metis h9 not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
     (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1
       ((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
       (2 * isolate_variable_sparse p var 2) At)
     (xs' @ x # xs) =  aEval At (xs' @ (((- b + 1 * sqrt (b2 - 4 * a * c)) / (2 * a)) # xs))"
      using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At]
        var_not_in_eval3 free_in_quad[OF h9 h10 h4 h11]
      by (metis assms(3) list_update_length) 
    have h2 : "aEval At (xs' @ (- b + 1 * sqrt (b2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) 1 (b2 - 4 * a * c) (2 * a) At') x"
    proof(cases At)
      case (Less p)
      then show ?thesis
      proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Less apply(cases "MPoly_Type.degree p var < 3") by simp_all
      qed
    next
      case (Eq p)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all
      qed
    next
      case (Leq x3)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    next
      case (Neq x4)
      then show ?thesis 
      proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    qed
    show ?case
      unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h h2
      by auto
  qed
  have quadratic_2 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹ (∀f∈set L2.
          eval
           (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (- 1)
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni (quadraticSubUni (- b) (- 1) (b2 - 4 * a * c) (2 * a) l) x)"
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = -1"
      unfolding insertion_neg
      by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(-1::real mpoly)"
      by (metis h9 not_in_neg not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
     (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1)
       ((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
       (2 * isolate_variable_sparse p var 2) At)
     (xs' @ x # xs) =  aEval At (xs' @(((- b - 1 * sqrt (b2 - 4 * a * c)) / (2 * a)) # xs))"
      using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At]
        var_not_in_eval3 free_in_quad[OF h9 h10 h4 h11]
      using assms(3) by fastforce 
    have h2 : "aEval At (xs'  @(- b - 1 * sqrt (b2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) (-1) (b2 - 4 * a * c) (2 * a) At') x"
    proof(cases At)
      case (Less p)
      then show ?thesis
      proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Less apply(cases "MPoly_Type.degree p var < 3")  by simp_all 
      qed
    next
      case (Eq p)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all
      qed
    next
      case (Leq x3)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Leq apply(cases "MPoly_Type.degree p var < 3")
          by (auto)
      qed
    next
      case (Neq x4)
      then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)")
        case None
        then show ?thesis
          using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Some aT)
        then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT"
          by (metis assms(3) convert_atom_change) 
        show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)]
          using At'[symmetric] Some[symmetric]
          unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto
      qed
    qed
    show ?case
      unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h h2
      by auto
  qed
  show ?thesis using assms(1)[symmetric] unfolding Leq apply(cases "MPoly_Type.degree p var < 3") apply simp_all
    apply(simp del : linearSubstitutionUni.simps quadraticSubUni.simps
        add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four
        a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj
        eval_list_conj_Uni ) using linear
    using quadratic_1 quadratic_2
    by smt
next
  case (Neq p)
  define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)"
  have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def
    using insertion_isovarspars_free[of "xs'  @x#xs" var x p 2 0] using assms by auto
  define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))"
  have b_def' : "b = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def
    using insertion_isovarspars_free[of "xs'@x#xs" var x p "(Suc 0)" 0] using assms by auto
  define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)"
  have c_def' : "c = insertion (nth_default 0 (xs'@0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def
    using insertion_isovarspars_free[of "xs'@x#xs" var x p 0 0] using assms by auto
  have linear : "b≠0 ⟹ (∀f∈set L2.
         eval
          (substInfinitesimalLinear var 
            (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f)
          (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalLinearUni b c l) x)"
    using assms(2) proof(induction L2 arbitrary : L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(3) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(3) At'
      by (simp_all add: L2's)
    have h : "eval
         (substInfinitesimalLinear var 
           (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At)
         (xs' @ x # xs) = evalUni (substInfinitesimalLinearUni b c At') x"
    proof(cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by simp_all
    next
      case (Some a)
      have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))"
        by (simp add: not_in_isovarspar) 
      have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) 
      have h :  "evalUni (substInfinitesimalLinearUni b c a) x =
    evalUni (substInfinitesimalLinearUni b c At') x"
      proof(cases At)
        case (Less p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Eq p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all
      next
        case (Leq x3)
        then show ?thesis using At' Some by auto 
      next
        case (Neq x4)
        then show ?thesis using At' Some by auto 
      qed
      show ?thesis unfolding convert_substInfinitesimalLinear[OF Some b_def[symmetric] c_def[symmetric] Cons(2) h1 h2 assms(3)]
        using h .
    qed
    show ?case unfolding L2' using h Cons(1)[OF Cons(2) L2's] by auto
  qed
  have quadratic_1 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹ (∀f∈set L2.
          eval
           (substInfinitesimalQuadratic var
             (- isolate_variable_sparse p var (Suc 0)) 1
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni
           (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) l)
           x)"
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length (xs' @ x # xs)" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(1::real mpoly)"
      by (metis h9 not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
      (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) 1
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
        (2 * isolate_variable_sparse p var 2) At)
      (xs' @ x # xs) =  evalUni
      (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) At') x"
    proof (cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by auto
    next
      case (Some aT)
      have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto
      have h2 : "insertion (nth_default 0 (xs' @ x # xs)) 1 = 1" by auto
      have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b2 - 4 * a * c)"
        unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def
        by auto
      have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a"
        unfolding insertion_mult a_def
        by (metis insertion_add insertion_mult mult_2)
      have h5 : "2 * a ≠ 0" using Cons by auto
      have h6 : "0 ≤ b2 - 4 * a * c" using Cons by auto
      have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
        by (simp add: not_in_isovarspar not_in_neg)
      have h8 : "var∉vars(1::real mpoly)"
        by (metis h9 not_in_pow power.simps(1))
      have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))2 -
             4 * isolate_variable_sparse p var 2 *
             isolate_variable_sparse p var 0)"
        by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
      have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)"
        by (metis isovarspar_sum mult_2 not_in_isovarspar)
      have h : "evalUni (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) aT)
     x =
    evalUni (substInfinitesimalQuadraticUni (- b) 1 (b2 - 4 * a * c) (2 * a) At')
     x"proof(cases At)
        case (Less p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Eq p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Leq x3)
        then show ?thesis using At' using Some by auto
      next
        case (Neq x4)
        then show ?thesis using At' using Some by auto 
      qed
      show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)]
        using h .
    qed


    show ?case
      unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h
      by auto
  qed
  have quadratic_2 : "(a ≠ 0) ⟹
     (4 * a * c ≤ b2) ⟹ (∀f∈set L2.
          eval
           (substInfinitesimalQuadratic var
             (- isolate_variable_sparse p var (Suc 0)) (- 1)
             ((isolate_variable_sparse p var (Suc 0))2 -
              4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
             (2 * isolate_variable_sparse p var 2) f)
           (xs' @ x # xs)) = (∀l∈set L2'.
          evalUni
           (substInfinitesimalQuadraticUni (- b) (- 1) (b2 - 4 * a * c) (2 * a)
             l)
           x)" 
    using assms(2) proof(induction L2 arbitrary: L2')
    case Nil
    then show ?case by auto
  next
    case (Cons At L2)
    have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At)
      case (Less p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Eq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all
    next
      case (Leq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    next
      case (Neq p)
      then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto
    qed 
    then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto
    have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's"
      using Cons(4) At'
      apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto
    then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto
    have L2' : "L2' = At' # L2's"
      using Cons(4) At' apply(cases At) apply auto
      by (simp_all add: L2's)
    have h1 :  "var < length ((xs' @ x # xs))" using assms by auto
    have h2 : "2*a ≠0" using Cons by auto
    have h3 : "0≤b^2-4*a*c" using Cons(3) by auto
    have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))2 -
            4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)"
      by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
    have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b"
      unfolding insertion_neg b_def
      by (metis insertion_isovarspars_free list_update_id) 
    have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = (-1)" unfolding insertion_neg by auto
    have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa]))
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) =
       b2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def)
      by (metis insertion_isovarspars_free list_update_id)
    have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly)  = (2::real)"
      by (metis MPoly_Type.insertion_one insertion_add one_add_one)  
    then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a"
      unfolding insertion_mult a_def apply auto
      by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar)
    have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
      by (simp add: not_in_isovarspar not_in_neg)
    have h10 : "var∉vars(- 1::real mpoly)"
      by (metis h9 not_in_neg not_in_pow power.simps(1))
    have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)"
      by (metis isovarspar_sum mult_2 not_in_isovarspar)
    have h :  "eval
      (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) (-1)
        ((isolate_variable_sparse p var (Suc 0))2 -
         4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)
        (2 * isolate_variable_sparse p var 2) At)
      (xs' @ x # xs) =  evalUni
      (substInfinitesimalQuadraticUni (- b) (-1) (b2 - 4 * a * c) (2 * a) At') x"
    proof (cases "convert_atom var At (xs' @ x # xs)")
      case None
      then show ?thesis using At' apply(cases At) by auto
    next
      case (Some aT)
      have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto
      have h2 : "insertion (nth_default 0 (xs' @ x # xs)) (-1) = -1" unfolding insertion_neg by auto
      have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))2 -
        4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b2 - 4 * a * c)"
        unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def
        by auto
      have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a"
        unfolding insertion_mult a_def
        by (metis insertion_add insertion_mult mult_2)
      have h5 : "2 * a ≠ 0" using Cons by auto
      have h6 : "0 ≤ b2 - 4 * a * c" using Cons by auto
      have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))"
        by (simp add: not_in_isovarspar not_in_neg)
      have h8 : "var∉vars(- 1::real mpoly)"
        by (simp add: h10 not_in_neg)
      have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))2 -
             4 * isolate_variable_sparse p var 2 *
             isolate_variable_sparse p var 0)"
        by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0)
      have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)"
        by (metis isovarspar_sum mult_2 not_in_isovarspar)
      have h : "evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b2 - 4 * a * c) (2 * a) aT)
     x =
    evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b2 - 4 * a * c) (2 * a) At')
     x"proof(cases At)
        case (Less p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Eq p)
        then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto
      next
        case (Leq x3)
        then show ?thesis using At'
          using Some option.inject by auto 
      next
        case (Neq x4)
        then show ?thesis using At'
          using Some by auto 
      qed
      show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)]
        using h .
    qed


    show ?case
      unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps)
      unfolding 
        Cons(1)[OF Cons(2) Cons(3) L2's]
      unfolding h
      by auto
  qed

  show ?thesis using assms(1)[symmetric] unfolding Neq apply(cases "MPoly_Type.degree p var < 3") apply simp_all
    apply(simp del : substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps
        add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four
        a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj
        eval_list_conj_Uni
        ) using linear quadratic_1 quadratic_2 by smt
qed

lemma convert_list : 
  assumes "convert_atom_list var L (xs' @ x # xs) = Some L'"
  assumes "l∈set(L)"
  shows "∃l'∈ set L'. convert_atom var l (xs' @ x # xs) = Some l'"
  using assms
proof(induction L arbitrary : L')
  case Nil
  then show ?case by auto
next
  case (Cons At L)
  then show ?case proof(cases At)
    case (Less p)
    then show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Less apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Less p") by simp_all
  next
    case (Eq p)
    show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Eq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Eq p") by simp_all
  next
    case (Leq p)
    then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Leq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Leq p") by simp_all
  next
    case (Neq p)
    then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Neq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Neq p") by simp_all
  qed
qed

lemma convert_list2 : 
  assumes "convert_atom_list var L (xs' @ x # xs) = Some L'"
  assumes "l'∈set(L')"
  shows "∃l∈ set L. convert_atom var l (xs' @ x # xs) = Some l'"
  using assms
proof(induction L arbitrary : L')
  case Nil
  then show ?case by auto
next
  case (Cons At L)
  then show ?case proof(cases At)
    case (Less p)
    then show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Less apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all
      by blast
  next
    case (Eq p)
    show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Eq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast
  next
    case (Leq p)
    then show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Leq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast
  next
    case (Neq p)
    then show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Neq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all
      apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast
  qed
qed

lemma elimVar_atom_convert : 
  assumes "convert_atom_list var L (xs' @ x # xs) = Some L'"
  assumes "convert_atom_list var L2 (xs' @ x # xs) = Some L2'"
  assumes "length xs' = var"
  shows "(∃f∈set L. eval (elimVar var L2 [] f) (xs' @ x # xs))
         = (∃f∈set L'. evalUni (elimVarUni_atom L2' f) x)"
proof safe
  fix f
  assume h : "f ∈ set L"
    "eval (elimVar var L2 [] f) (xs' @ x # xs)"
  have "∃f'∈set L'. convert_atom var f (xs' @ x # xs) = Some f'"
    using convert_list h assms by auto
  then obtain f' where f' : "f'∈set L'" "convert_atom var f (xs' @ x # xs) = Some f'" by metis
  show "∃f∈set L'. evalUni (elimVarUni_atom L2' f) x"
    apply(rule bexI[where x=f']) using f' elimVar_atom_single[OF f'(2) assms(2) assms(3)] h by auto
next
  fix f'
  assume h : "f' ∈ set L'"
    "evalUni (elimVarUni_atom L2' f') x"
  have "∃f∈set L. convert_atom var f (xs' @ x # xs) = Some f'" using convert_list2 h assms by auto
  then obtain f where f : "f∈set L" "convert_atom var f (xs' @ x # xs) = Some f'" by metis
  show "∃f∈set L. eval (elimVar var L2 [] f) (xs' @ x # xs)"
    apply(rule bexI[where x=f]) using f elimVar_atom_single[OF f(2) assms(2) assms(3)] h by auto
qed


lemma eval_convert : 
  assumes "convert_atom_list var L (xs' @ x # xs) = Some L'"
  assumes "length xs' = var"
  shows "(∀f∈set L. aEval f (xs' @ x # xs)) = (∀f∈set L'. aEvalUni f x)"
  using assms
proof(induction L arbitrary : L')
  case Nil
  then show ?case by auto
next
  case (Cons a L)
  then show ?case proof(cases a)
    case (Less p)
    then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Less apply(cases " MPoly_Type.degree p var < 3")
      apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all
      by (simp add: poly_to_univar) 
  next
    case (Eq p)
    then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Eq apply(cases " MPoly_Type.degree p var < 3")
      apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all
      by (simp add: poly_to_univar) 
  next
    case (Leq p)
    show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Leq apply(cases " MPoly_Type.degree p var < 3") 
      apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all
      by (simp add: poly_to_univar) 
  next
    case (Neq p)
    show ?thesis  using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Neq apply(cases " MPoly_Type.degree p var < 3") 
      apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all
      by (simp add: poly_to_univar) 
  qed
qed
lemma all_degree_2_convert : 
  assumes "all_degree_2 var L"
  shows "∃L'. convert_atom_list var L xs = Some L'"
  using assms
proof(induction L)
  case Nil
  then show ?case by auto
next
  case (Cons a L)
  then show ?case proof(cases a)
    case (Less p)
    show ?thesis using Cons unfolding Less all_degree_2.simps convert_atom_list.simps convert_atom.simps
      using degree_convert_eq[of var p xs] by auto
  next
    case (Eq p)
    then show ?thesis using Cons unfolding Eq all_degree_2.simps convert_atom_list.simps convert_atom.simps
      using degree_convert_eq[of var p xs] by auto
  next
    case (Leq x3)
    then show ?thesis using Cons by auto
  next
    case (Neq x4)
    then show ?thesis using Cons by auto
  qed
qed
lemma gen_qe_eval :
  assumes hlength : "length xs = var"
  shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval (gen_qe var L F) (xs @ (x#Γ))))"
proof(cases "luckyFind var L []")
  case None
  then have notLucky : "luckyFind var L [] = None" by auto 
  then show ?thesis proof(cases F)
    case Nil
    then show ?thesis proof(cases "all_degree_2 var L")
      case True
      then have "⋀x.∃L'. convert_atom_list var L (xs@x#Γ) = Some L'" using all_degree_2_convert[of var L "xs@_#Γ"] by auto
      then obtain L' where L' : "convert_atom_list var L (xs@x#Γ) = Some L'" by metis
      then have L' : "⋀x. convert_atom_list var L (xs@x#Γ) = Some L'"
        by (metis convert_atom_list_change hlength)
      show ?thesis
        unfolding Nil apply (simp add:eval_list_conj eval_list_disj True del:luckyFind.simps) unfolding notLucky apply (simp add:eval_list_conj eval_list_disj)
        using negInf_convert[OF L' assms] elimVar_atom_convert[OF L' L' assms] eval_convert[OF L' assms]
        using eval_generalVS''[of L'] unfolding eval_list_conj_Uni generalVS_DNF.simps eval_list_conj_Uni eval_list_disj_Uni eval_append eval_map eval_map_all
          evalUni.simps 

        by auto
    next
      case False
      then show ?thesis using notLucky unfolding Nil  False apply simp
        by (metis append_Nil2 hlength notLucky option.simps(4) qe_eq_repeat.simps qe_eq_repeat_eval) 
    qed
  next
    case (Cons a list)
    show ?thesis
      apply(simp add:Cons del:qe_eq_repeat.simps)
      apply(rule qe_eq_repeat_eval[of xs var L "a # list" Γ])
      using assms .
  qed
next
  case (Some a)
  then show ?thesis
    using luckyFind_eval[OF Some assms] apply(cases F) apply simp 
    apply(simp add:Cons del:qe_eq_repeat.simps)
    using qe_eq_repeat_eval[of xs var L _ Γ]
    using assms  by auto
qed


lemma freeIn_elimVar : "freeIn var (elimVar var L F A)"
proof(cases A)
  case (Less p)
  have two: "2 = Suc(Suc 0)" by auto
  have notIn4: "var ∉ vars (4::real mpoly)"
    by (metis isolate_var_one not_in_add not_in_isovarspar numeral_plus_numeral one_add_one semiring_norm(2) semiring_norm(6)) 
  show ?thesis using Less apply auto
    using not_in_isovarspar apply force+
    apply (rule freeIn_list_conj)
    apply auto
    defer defer
    using not_in_isovarspar apply force+
    using not_in_sub[OF not_in_mult[of var 4, OF _ not_in_mult[of var "isolate_variable_sparse p var 2" "isolate_variable_sparse p var 0"]], of "(isolate_variable_sparse p var (Suc 0))2"]
    apply (simp add:not_in_isovarspar two)
    using not_in_mult[of var "isolate_variable_sparse p var (Suc 0)" "isolate_variable_sparse p var (Suc 0)"]
    apply (simp add:not_in_isovarspar notIn4)
    apply (simp add: ideal.scale_scale)
    apply(rule freeIn_list_conj)
    apply auto
    defer defer
    apply(rule freeIn_list_conj)
    apply auto
    apply(rule freeIn_substInfinitesimalQuadratic) apply auto
    using not_in_isovarspar not_in_neg apply blast
    apply (metis not_in_isovarspar not_in_neg not_in_pow power_0)
    using notIn4 not_in_isovarspar not_in_mult not_in_pow not_in_sub apply auto[1]
    apply (metis isovarspar_sum mult_2 not_in_isovarspar)
    using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" "-1" "((isolate_variable_sparse p var (Suc 0))2 -
                      4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"] apply auto[1]
    apply (metis (no_types, lifting) mult_2 notIn4 not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow not_in_sub power_0)
    apply(rule freeIn_substInfinitesimalLinear)
    apply (meson not_in_isovarspar not_in_neg)
    apply (simp add: not_in_isovarspar)
    using freeIn_substInfinitesimalLinear_fm
    using not_in_isovarspar not_in_neg apply force
    apply (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))2)› freeIn_substInfinitesimalQuadratic minus_diff_eq mult.assoc mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0)
    using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" 1 "((isolate_variable_sparse p var (Suc 0))2 -
                      4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"]
    apply auto
    by (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))2)› ideal.scale_scale minus_diff_eq mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0)
next
  case (Eq p)
  then show ?thesis using freeIn_elimVar_eq by auto
next
  case (Leq p)
  then show ?thesis using freeIn_elimVar_eq by auto
next
  case (Neq p)
  have two: "2 = Suc(Suc 0)" by auto
  have notIn4: "var ∉ vars (4::real mpoly)"
    by (metis isolate_var_one not_in_add not_in_isovarspar numeral_plus_numeral one_add_one semiring_norm(2) semiring_norm(6)) 
  show ?thesis using Neq apply auto
    using not_in_isovarspar apply force+
    apply (rule freeIn_list_conj)
    apply auto
    defer defer
    using not_in_isovarspar apply force+
    using not_in_sub[OF not_in_mult[of var 4, OF _ not_in_mult[of var "isolate_variable_sparse p var 2" "isolate_variable_sparse p var 0"]], of "(isolate_variable_sparse p var (Suc 0))2"]
    apply (simp add:not_in_isovarspar two)
    using not_in_mult[of var "isolate_variable_sparse p var (Suc 0)" "isolate_variable_sparse p var (Suc 0)"]
    apply (simp add:not_in_isovarspar notIn4)
    apply (simp add: ideal.scale_scale)
    apply(rule freeIn_list_conj)
    apply auto
    defer defer
    apply(rule freeIn_list_conj)
    apply auto
    apply(rule freeIn_substInfinitesimalQuadratic) apply auto
    using not_in_isovarspar not_in_neg apply blast
    apply (metis not_in_isovarspar not_in_neg not_in_pow power_0)
    using notIn4 not_in_isovarspar not_in_mult not_in_pow not_in_sub apply auto[1]
    apply (metis isovarspar_sum mult_2 not_in_isovarspar)
    using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" "-1" "((isolate_variable_sparse p var (Suc 0))2 -
                      4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"] apply auto[1]
    apply (metis (no_types, lifting) mult_2 notIn4 not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow not_in_sub power_0)
    apply(rule freeIn_substInfinitesimalLinear)
    apply (meson not_in_isovarspar not_in_neg)
    apply (simp add: not_in_isovarspar)
    using freeIn_substInfinitesimalLinear_fm
    using not_in_isovarspar not_in_neg apply force
    apply (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))2)› freeIn_substInfinitesimalQuadratic minus_diff_eq mult.assoc mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0)
    using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" 1 "((isolate_variable_sparse p var (Suc 0))2 -
                      4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"]
    apply auto
    by (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))2)› ideal.scale_scale minus_diff_eq mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0)
qed

lemma freeInDisj: "freeIn var (list_disj (list_conj (map (substNegInfinity var) L) # map (elimVar var L []) L))"
  apply(rule freeIn_list_disj)
  apply(auto)
  apply(rule freeIn_list_conj)
  apply simp

  using freeIn_substNegInfinity[of var]
  apply simp
  using freeIn_elimVar
  by simp

lemma gen_qe_eval' :
  assumes "all_degree_2 var L"
  assumes "length xs' = var"
  shows "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∀x.(eval (gen_qe var L []) (xs'@x#Γ)))"
    "freeIn var (gen_qe var L [])"
proof-
  have h : "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∃x. eval (gen_qe var L []) (xs'@x # Γ))"
    using gen_qe_eval[OF assms(2), of L "[]" Γ] unfolding List.append.left_neutral  by auto
  show "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∀x.(eval (gen_qe var L []) (xs'@x#Γ)))"
    unfolding h
    apply (simp add:assms)
    apply(cases "find_lucky_eq var L")
    apply simp using freeInDisj[of var L]
    using var_not_in_eval3[OF _ assms(2)] apply blast
    subgoal for a
      using freeIn_elimVar_eq[of var L "[]" a]
      apply(simp del:elimVar.simps)
      using var_not_in_eval3[OF _ assms(2)] by blast
    done
next
  show "freeIn var (gen_qe var L []) "
    apply(simp add:assms)
    apply(cases "find_lucky_eq var L") apply (simp add:freeInDisj)
    subgoal for a
      using freeIn_elimVar_eq[of var L "[]" a]
      by(simp del:elimVar.simps)
    done
qed



lemma gen_qe_eval'' :
  assumes "all_degree_2 var L"
  assumes "length xs' = var"
  shows "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∀x.(eval (list_disj
                          (list_conj (map (substNegInfinity var) L) # map (elimVar var L []) L)) (xs'@x#Γ)))"
proof(cases "convert_atom_list var L (xs'@x#Γ)")
  case None
  then show ?thesis using all_degree_2_convert[OF assms(1), of "(xs' @ x # Γ)"] by auto
next
  case (Some a)
  then have Some : "⋀x. convert_atom_list var L (xs'@x#Γ) = Some a"  using convert_atom_list_change[OF assms(2), of L x Γ]
    by fastforce

  show ?thesis
    apply (simp add: eval_list_conj eval_list_disj)
    using negInf_convert[OF Some assms(2)] elimVar_atom_convert[OF Some Some assms(2)] eval_convert[OF Some assms(2)]
    using eval_generalVS''[of a] unfolding eval_list_conj_Uni generalVS_DNF.simps eval_list_conj_Uni eval_list_disj_Uni eval_append eval_map eval_map_all
      evalUni.simps 
    by auto
qed

end

Theory DNF

section "QE Algorithm Proofs"
subsection "DNF"
theory DNF
  imports VSAlgos
begin


theorem dnf_eval : 
  "(∃(al,fl)∈set (dnf φ). 
     (∀a∈set al. aEval a xs) 
   ∧ (∀f∈set fl. eval f xs))
   = eval φ xs"
proof(induction φ)
  case (And φ1 φ2)
  define f where "f = (λa. case a of
        (al, fl) ⇒ (∀a∈set al. aEval a xs) ∧ (∀f∈set fl. eval f xs))"
  have h1:"(∃a∈set (dnf (And φ1 φ2)). f a) = (∃a∈set (dnf φ1). ∃a'∈set(dnf φ2). f a ∧ f a')"
    apply simp unfolding f_def apply auto
      apply blast
     apply blast
    subgoal for a b c d
      apply(rule bexI[where x="(a,b)"])
       apply(rule exI[where x="a@c"])
       apply(rule exI[where x="b@d"])
      by auto
    done
  also have h2 : "... = ((∃a∈set (dnf φ1). f a)∧(∃a∈set(dnf φ2). f a))"
    by auto
  show ?case unfolding f_def[symmetric] unfolding h1 h2 unfolding f_def using And by auto
qed auto


theorem dnf_modified_eval : 
  "(∃(al,fl,n)∈set (dnf_modified φ).
      (∃L. (length L = n 
       ∧ (∀a∈set al. aEval a (L@xs))
       ∧ (∀f∈set fl. eval f (L@xs))))) = eval φ xs"
proof(induction φ arbitrary:xs)
  case (Atom x)
  then show ?case
    by (cases x, auto)
next
  case (And φ1 φ2)
  {fix d1 d2 A A' B B' L1 L2
    assume A : "(A,A',length (L1::real list))∈set (dnf_modified φ1)" and "(B,B',length (L2::real list))∈set (dnf_modified φ2)"
    have "(
      (∀a∈set ((map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B)). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set ( map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs))) = 
      (
      (∀a∈set(map (liftAtom (length L1) (length L2)) A) ∪ set( map (liftAtom 0 (length L1)) B). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set( map (liftFm (length L1) (length L2)) A') ∪ set(map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs)))"
      by auto
    also have "... = (
      (∀a∈set(map (liftAtom (length L1) (length L2)) A).aEval a ((L1@L2) @ xs))
    ∧ (∀a∈set(map (liftAtom 0 (length L1)) B). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set(map (liftFm (length L1) (length L2)) A').eval f ((L1@L2) @ xs))
    ∧ (∀f∈set(map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs)))"
      by blast
    also have "... =  (
      (∀a∈set A. aEval (liftAtom (length L1) (length L2) a) ((L1@L2) @ xs))
    ∧ (∀a∈set B. aEval (liftAtom 0 (length L1) a) ((L1@L2) @ xs)) 
    ∧ (∀f∈set A'. eval (liftFm (length L1) (length L2) f) ((L1@L2) @ xs))
    ∧ (∀f∈set B'. eval (liftFm 0 (length L1) f) ((L1@L2) @ xs)))"
      by simp 
    also have "... =  (
      (∀a∈set A. aEval (liftAtom (length L1) (length L2) a) (insert_into (L1 @ xs) (length L1) L2))
    ∧ (∀a∈set B. aEval (liftAtom 0 (length L1) a) (insert_into (L2 @ xs) 0 L1)) 
    ∧ (∀f∈set A'. eval (liftFm (length L1) (length L2) f) (insert_into (L1 @ xs) (length L1) L2))
    ∧ (∀f∈set B'. eval (liftFm 0 (length L1) f) (insert_into (L2 @ xs) 0 L1)))"
      by auto
    also have "... = ( 
          ((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ 
          ((∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))) )"
    proof safe
      fix a
      show "∀a∈set A. aEval (liftAtom (length L1) (length L2) a) (insert_into (L1 @ xs) (length L1) L2) ⟹
           a ∈ set A ⟹ aEval a (L1 @ xs)"
        using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" "Atom a", OF refl]
        by auto
    next
      fix f
      show "∀f∈set A'. eval (liftFm (length L1) (length L2) f) (insert_into (L1 @ xs) (length L1) L2) ⟹
          f ∈ set A' ⟹ eval f (L1 @ xs)"
        using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" f, OF refl] by auto
    next 
      fix a
      show " ∀a∈set B. aEval (liftAtom 0 (length L1) a) (insert_into (L2 @ xs) 0 L1) ⟹
            a ∈ set B ⟹ aEval a (L2 @ xs)"
        using eval_liftFm[of L1 "length L1" "0" "L2@xs" "Atom a", OF refl] by auto
    next
      fix f
      show " ∀f∈set B'. eval (liftFm 0 (length L1) f) (insert_into (L2 @ xs) 0 L1) ⟹ f ∈ set B' ⟹ eval f (L2 @ xs)"
        using eval_liftFm[of L1 "length L1" "0" "L2 @ xs" f, OF refl] by auto
    next
      fix a
      show " ∀a∈set A. aEval a (L1 @ xs) ⟹
         a ∈ set A ⟹ aEval (liftAtom (length L1) (length L2) a) (insert_into (L1 @ xs) (length L1) L2)"
        using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" "Atom a", OF refl] by auto
    next
      fix a
      show "∀a∈set B. aEval a (L2 @ xs) ⟹ a ∈ set B ⟹ aEval (liftAtom 0 (length L1) a) (insert_into (L2 @ xs) 0 L1)"
        using eval_liftFm[of L1 "length L1" "0" "L2@xs" "Atom a", OF refl] by auto
    next
      fix f 
      show "∀f∈set A'. eval f (L1 @ xs) ⟹
         f ∈ set A' ⟹ eval (liftFm (length L1) (length L2) f) (insert_into (L1 @ xs) (length L1) L2)"
        using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" f, OF refl] by auto
    next
      fix f
      show "∀f∈set B'. eval f (L2 @ xs) ⟹ f ∈ set B' ⟹ eval (liftFm 0 (length L1) f) (insert_into (L2 @ xs) 0 L1)"
        using eval_liftFm[of L1 "length L1" "0" "L2 @ xs" f, OF refl] by auto
    qed
    finally have "(
      (∀a∈set ((map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B)). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set ( map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs))) = ( 
          ((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ 
          ((∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))) )"
      by simp
  }
  then have h : "(∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ 
      (∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1@L2) @ xs)))) = ((∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set(dnf_modified φ2). 
          (∃L1. length L1 = d1 ∧ (∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ 
          (∃L2. length L2 = d2 ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))) ))"
  proof safe
    fix A A' B B'  L1 L2
    assume prev : "(⋀A A' L1 B B' L2.
           (A, A', length L1) ∈ set (dnf_modified φ1) ⟹
           (B, B', length L2) ∈ set (dnf_modified φ2) ⟹
           ((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B).
                aEval a ((L1 @ L2) @ xs)) ∧
            (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B').
                eval f ((L1 @ L2) @ xs))) =
           (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧
            (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))))"
      and A: "(A,A',length L1)∈set (dnf_modified φ1)" and B: "(B,B',length L2)∈set (dnf_modified φ2)"
      and h1 : "∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B).
          aEval a ((L1 @ L2) @ xs)"
      and h2 : "∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B').
          eval f ((L1 @ L2) @ xs)"
    have h : "((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B).
         aEval a ((L1 @ L2) @ xs)) ∧
     (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B').
         eval f ((L1 @ L2) @ xs))) =
    (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧
     (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs)))"
      using prev[where A="A", where A'="A'", where B="B", where B'="B'"] A B by simp
    show "∃(A, A', d1)∈set (dnf_modified φ1).
          ∃(B, B', d2)∈set (dnf_modified φ2).
             (∃L1. length L1 = d1 ∧ (∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧
             (∃L2. length L2 = d2 ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs)))"
      apply (rule bexI[where x="(A, A', length L1)", OF _ A])
      apply auto defer
      apply (rule bexI[where x="(B, B', length L2)", OF _ B])
      apply auto
      using h h1 h2
      by auto
  next
    fix A A' d1 B B' d2 L1 L2
    assume prev : "(⋀A A' L1 B B' L2.
           (A, A', length L1) ∈ set (dnf_modified φ1) ⟹
           (B, B', length L2) ∈ set (dnf_modified φ2) ⟹
           ((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B).
                aEval a ((L1 @ L2) @ xs)) ∧
            (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B').
                eval f ((L1 @ L2) @ xs))) =
           (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧
            (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))))"
      and A: "(A,A',length L1)∈set (dnf_modified φ1)" and B: "(B,B',length L2)∈set (dnf_modified φ2)"
      and h1 : "∀a∈set A. aEval a (L1 @ xs)" "∀f∈set A'. eval f (L1 @ xs)"
      "∀a∈set B. aEval a (L2 @ xs)" "∀f∈set B'. eval f (L2 @ xs)"
    have h : "((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B).
         aEval a ((L1 @ L2) @ xs)) ∧
     (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B').
         eval f ((L1 @ L2) @ xs))) =
    (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧
     (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs)))"
      using prev[where A="A", where A'="A'", where B="B", where B'="B'"] h1 A B by simp
    show "∃(A, A', d1)∈set (dnf_modified φ1).
          ∃(B, B', d2)∈set (dnf_modified φ2).
             ∃L1 L2.
                length L1 = d1 ∧
                length L2 = d2 ∧
                (∀a∈set (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B). aEval a ((L1 @ L2) @ xs)) ∧
                (∀f∈set (map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1 @ L2) @ xs))"
      apply (rule bexI[where x="(A, A', length L1)", OF _ A])
      apply auto defer
      apply (rule bexI[where x="(B, B', length L2)", OF _ B])
      apply auto
      apply (rule exI[where x="L1"])
      apply auto
      apply (rule exI[where x="L2"])
      apply auto
      using h h1 by auto
  qed

  define f where "f (x:: (atom list * atom fm list * nat)) = (case x of (al,fl,n) ⇒ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))))" for x
  define g where "((g (uuaa::atom list) (uua::atom fm list) (uu::nat) x):: (atom list * atom fm list * nat)) = (
 case x of
                       (B, B', d2) ⇒
                         (map (liftAtom uu d2) uuaa @ map (liftAtom 0 uu) B,
                          map (λx. map_fm_binders (λa x. liftAtom (uu + x) d2 a) x 0) uua @
                          map (λx. map_fm_binders (λa x. liftAtom (0 + x) uu a) x 0) B',
                          uu + d2))" for uuaa uua uu x

  define f' where "f' L A A' d1 B B' d2 = ((∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a (L @ xs)) 
    ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f (L @ xs)))" for L A A' d1 B B' d2
  have "(∃(al, fl, n)∈set (dnf_modified (And φ1 φ2)).
               ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))
        = (∃y∈set (dnf_modified (And φ1 φ2)). f y)"
    unfolding f_def by simp
  also have "... = (∃y∈set (dnf_modified φ1).
        ∃a aa b.
           (∃uu uua uuaa.
               (uuaa, uua, uu) = y ∧
               (a, aa, b)
               ∈ (g uuaa uua uu) `
                  set (dnf_modified φ2)) ∧
           f (a, aa, b))"
    using g_def by simp
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1).
        ∃x∈set (dnf_modified φ2).
           f (g A A' d1 x))"
    by (smt case_prodE f_def imageE image_eqI prod.simps(2))
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1).
        ∃x∈set (dnf_modified φ2).
           f (case x of (B,B',d2) ⇒ (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B,
                          map (λx. liftFm d1 d2 x) A' @
                          map (λx. liftFm 0 d1 x) B',
                          d1 + d2)))"
    using g_def by simp 
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃x∈set (dnf_modified φ2).
      (case (case x of (B,B',d2) ⇒ (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B,
                          map (λx. liftFm d1 d2 x) A' @ map (λx. liftFm 0 d1 x) B',
                          d1 + d2)) of (al,fl,n) ⇒ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))))
)"
    using f_def by simp
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (case ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B,
                          map (λx. liftFm d1 d2 x) A' @ map (λx. liftFm 0 d1 x) B',
                          d1 + d2)) of (al,fl,n) ⇒ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))))
)"  
    by(smt case_prodE case_prodE2 old.prod.case)
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (∃L. length L = d1 + d2 ∧ 
      (∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a (L @ xs)) 
    ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f (L @ xs))))"  
    by(smt case_prodE case_prodE2 old.prod.case)
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (∃L. length L = d1 + d2 ∧ (f' L A A' d1 B B' d2)))"  
    using f'_def by simp
  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ (f' (L1@L2) A A' d1 B B' d2)))"
  proof safe
    fix A A' d1 B B' d2 L
    assume A: "(A,A',d1)∈set (dnf_modified φ1)" and B: "(B,B',d2)∈set (dnf_modified φ2)"
      and L: "length L = d1 + d2" "(f' L A A' d1 B B' d2)"
    show "∃(A, A', d1)∈set (dnf_modified φ1).
          ∃(B, B', d2)∈set (dnf_modified φ2). ∃L1 L2. length L1 = d1 ∧ length L2 = d2 ∧ f' (L1 @ L2) A A' d1 B B' d2"
      apply (rule bexI[where x="(A, A', d1)", OF _ A])
      apply auto
      apply (rule bexI[where x="(B, B', d2)", OF _ B])
      apply auto
      apply (rule exI[where x="take d1 L"])
      apply auto   defer
      apply (rule exI[where x="drop d1 L"])
      using L
      by auto
  next
    fix A A' d1 B B' d2 L1 L2
    assume A: "(A,A', length L1)∈set (dnf_modified φ1)" and B: "(B,B',length L2)∈set (dnf_modified φ2)"
      and L: "(f' (L1 @ L2) A A' (length L1) B B' (length L2))"
    thm exI
    thm bexI
    show "∃(A, A', d1)∈set (dnf_modified φ1). ∃(B, B', d2)∈set (dnf_modified φ2). ∃L. length L = d1 + d2 ∧ f' L A A' d1 B B' d2 "
      apply (rule bexI[where x="(A, A', length L1)", OF _ A])
      apply auto
      apply (rule bexI[where x="(B, B', length L2)", OF _ B])
      apply auto
      apply (rule exI[where x="L1 @ L2"])
      using L
      by auto
  qed

  also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ 
      (∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1@L2) @ xs))))" 
    unfolding f'_def by simp
      (*also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2).
      (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ 
      (∀a∈set (map (liftAtom d1 d2) A) ∪ set ( map (liftAtom 0 d1) B). aEval a ((L1@L2) @ xs)) 
    ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1@L2) @ xs))))"
    proof -
      have *: "(∀a∈set (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B). aEval a ((L1 @ L2) @ xs))
        = (∀a∈set (map (liftAtom d1 d2) A) ∪ set ( map (liftAtom 0 d1) B). aEval a ((L1@L2) @ xs))"
        for d1 d2 A B L1 L2 by auto
      then show ?thesis apply (subst * ) ..
    qed (*
      apply (rule bex_cong[OF refl])
      unfolding split_beta
      apply (rule bex_cong[OF refl])
      apply (rule ex_cong1)+
      apply (rule conj_cong refl)+
      by auto *)
    *)
  also have "... = ((∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set(dnf_modified φ2). 
          (∃L. length L = d1 ∧ (∀a∈set A. aEval a (L @ xs)) ∧ (∀f∈set A'. eval f (L @ xs))) ∧ 
          (∃L. length L = d2 ∧ (∀a∈set B. aEval a (L @ xs)) ∧ (∀f∈set B'. eval f (L @ xs))) ))"
    using h by simp
  also have "... = ((∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set(dnf_modified φ2). 
          f (A,A',d1) ∧ 
          f (B,B',d2)))"
    using f_def by simp
  also have "... = ((∃a∈set (dnf_modified φ1). ∃a1∈set(dnf_modified φ2). f a ∧ f a1))"
    by (simp add: Bex_def_raw)
  also have "... = ((∃a∈set (dnf_modified φ1). f a) ∧ (∃a∈set (dnf_modified φ2). f a))"
    by blast
  also have "... = eval (And φ1 φ2) xs"
    using And f_def by simp
  finally have "(∃(al, fl, n)∈set (dnf_modified (And φ1 φ2)).
               ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))) =
         eval (And φ1 φ2) xs"
    by simp
  then show ?case by simp
next
  case (Or φ1 φ2)
  have h1 : "eval (Or φ1 φ2) xs = eval φ1 xs ∨ eval φ2 xs"
    using eval.simps(5) by blast
  have h2 : "set (dnf_modified (Or φ1 φ2)) = set(dnf_modified φ1) ∪ set(dnf_modified φ2)"
    by simp 
  show ?case using Or h1 h2
    by (metis (no_types, lifting) Un_iff eval.simps(5)) 
next
  case (ExQ φ)
  have h1 : "((∃x. (∃(al, fl, n)∈set (dnf_modified φ).
               ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ (x#xs))) ∧ (∀f∈set fl. eval f (L @ (x#xs)))))
              =
              (∃(al, fl, n)∈set (dnf_modified φ).
               (∃x.∃L. length L = n ∧ (∀a∈set al. aEval a ((L@[x]) @ xs)) ∧ (∀f∈set fl. eval f ((L@[x]) @ xs)))))"
    apply simp by blast
  { fix n al fl
    define f where "f L = (length (L:: real list) = ((n::nat)+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))" for L
    have "(∃x.∃L. f (L@[x])) = (∃L. f L)"
      by (metis (full_types) One_nat_def add_Suc_right f_def list.size(3) nat.simps(3) rev_exhaust)
    then have "((∃x. ∃L. length (L@[x]) = (n+1) ∧ (∀a∈set al. aEval a ((L@[x]) @ xs)) ∧ (∀f∈set fl. eval f ((L@[x]) @ xs)))
              =
            (∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))))"
      unfolding f_def by simp  
  }
  then have h2 : "∀n al fl. (
              (∃x. ∃L. length (L@[x]) = (n+1) ∧ (∀a∈set al. aEval a ((L@[x]) @ xs)) ∧ (∀f∈set fl. eval f ((L@[x]) @ xs)))
              =
              (∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))
            )"
    by simp
  { fix al fl n
    define f where "f al fl n = (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))" for al fl n
    have "f al fl (n+1) = (case (case (al, fl, n) of (A, A', d) ⇒ (A, A',d+1)) of
             (al, fl, n) ⇒ f al fl n)"
      by simp
    then have "(∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))
              = (
             case (case (al, fl, n) of (A, A', d) ⇒ (A, A',d+1)) of
             (al, fl, n) ⇒
               ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))"
      unfolding f_def by simp
  }
  then have h3 : "
              (∃(al, fl, n)∈set (dnf_modified φ).
               ∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))
              = (∃a∈set (dnf_modified φ).
             case (case a of (A, A', d) ⇒ (A, A',d+1)) of
             (al, fl, n) ⇒
               ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))"
    by (smt case_prodE case_prodI2) (* takes a second *)
  show ?case using ExQ h1 h2 h3 by simp
next
  case (ExN x1 φ)

  show ?case
    apply simp proof safe
    fix a aa b L
    have takedrop: "(take b L @ drop b L @ xs) = (L @ xs)" by auto
    assume h: "(a, aa, b) ∈ set (dnf_modified φ)" "length L = b + x1" "∀a∈set a. aEval a (L @ xs)" "∀f∈set aa. eval f (L @ xs)"
    show "∃l. length l = x1 ∧ eval φ (l @ xs)"
      apply(rule exI[where x="drop b L"])
      apply auto
      using h(2) apply simp
      unfolding ExN[symmetric]
      apply(rule bexI[where x="(a,aa,b)"])
      apply simp
      apply(rule exI[where x="take b L"])
      apply auto
      using h apply simp
      unfolding takedrop
      using h by auto
  next
    fix l
    assume h: "eval φ (l @ xs)" "x1 = length l" 
    obtain al fl n where h1 : "(al, fl, n)∈set (dnf_modified φ)" "∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs))"
      using h(1) unfolding ExN[symmetric]
      by blast 
    obtain L where h2 : "length L = n" "(∀a∈set al. aEval a (L @ l @ xs))" "(∀f∈set fl. eval f (L @ l @ xs))" using h1(2) by metis 
    show "∃x∈set (dnf_modified φ).
            case case x of (A, A', d) ⇒ (A, A', d + length l) of
            (al, fl, n) ⇒ ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))"
      apply(rule bexI[where x="(al,fl,n)"])
      apply simp
      apply(rule exI[where x="L@l"])
      apply auto
      using h2 h1 by auto
  qed
qed auto
end

Theory VSQuad

subsection "Recursive QE"
theory VSQuad
  imports EqualityVS GeneralVSProofs Reindex OptimizationProofs DNF
begin

lemma existN_eval : "∀xs. eval (ExN n φ) xs = (∃L. (length L = n ∧ eval φ (L@xs)))"
proof(induction n)
  case 0
  then show ?case  by simp
next
  case (Suc n)
  {fix xs
    have "eval (ExN (Suc n) φ) xs = (∃l. length l = Suc n ∧ eval φ (l @ xs))"
      by simp
    also have "... = (∃x.∃L. (length L = n ∧ eval φ (L@(x#xs))))"
    proof safe
      fix l
      assume h : "length l = Suc n" "eval φ (l @ xs)"
      show "∃x L. length L = n ∧ eval φ (L @ x # xs)"
        apply(rule exI[where x="l ! n"])
        apply(rule exI[where x="take n l"])
        using h apply auto
        by (metis Cons_nth_drop_Suc append.assoc append_Cons append_take_drop_id lessI order_refl self_append_conv self_append_conv2 take_all)
    next
      fix x L
      assume h : "eval φ (L @ x # xs)" "n = length L"
      show "∃l. length l = Suc (length L) ∧ eval φ (l @ xs)"
        apply(rule exI[where x="L@[x]"])
        using h by auto
    qed
    also have "... = (∃x.∃L. (length L = n ∧ eval φ ((L@[x])@xs)))"
      by simp
    also have "... = (∃x.∃L. (length (L@[x]) = (Suc n) ∧ eval φ ((L@[x])@xs)))"
      by simp
    also have "... = (∃L. (length L = (Suc n) ∧ eval φ (L@xs)))"
      by (metis append_butlast_last_id length_0_conv nat.simps(3))
    finally have "eval (ExN (Suc n) φ) xs = (∃L. (length L = (Suc n) ∧ eval φ (L@xs)))"
      by simp
  }
  then show ?case by simp
qed




lemma boundedFlipNegQuantifier : "(¬(∀x∈A. ¬ P x)) = (∃x∈A. P x)"
  by blast


theorem QE_dnf'_eval: 
  assumes steph : "⋀amount F Γ.
    (∃xs. (length xs = amount ∧ eval (list_disj (map(λ(L,F,n). ExN n (list_conj (map fm.Atom L @ F))) F))  (xs @ Γ))) = (eval (step amount F)  Γ)"
  assumes opt : "⋀xs F . eval (opt F) xs = eval F xs"
  shows "eval (QE_dnf' opt step φ) xs = eval φ xs"
proof(induction φ arbitrary : xs)
  case (Atom x)
  then show ?case by (simp add: simp_atom_eval)
next
  case (And φ1 φ2)
  then show ?case by (simp add: eval_and) 
next
  case (Or φ1 φ2)
  then show ?case by (simp add: eval_or) 
next
  case (Neg φ)
  then show ?case  apply simp
    by (metis  eval_neg )  
next
  case (ExQ φ)
  have h1 : "⋀F. (∃xs. length xs = Suc 0 ∧
          F xs) = (∃x.
          F [x])"
    by (metis length_0_conv length_Suc_conv)
  show ?case
    apply simp 
    unfolding steph[symmetric] apply(simp add: eval_list_disj)
    unfolding h1 apply(rule ex_cong1)
    unfolding ExQ[symmetric]
    unfolding opt[symmetric, of "(QE_dnf' opt step φ)"]
    unfolding dnf_modified_eval[symmetric, of "(opt (QE_dnf' opt step φ))"]
    apply(rule bex_cong) apply simp
    subgoal for x f
      apply(cases f)
      apply (auto simp add:eval_list_conj)
      by (metis Un_iff eval.simps(1) imageI)
    done
next
  case (AllQ φ)
  have h1 : "⋀F. (∀xs::real list. (length xs = Suc 0 ⟶
          F xs)) = (∀x.
          F [x])"
    by (metis length_0_conv length_Suc_conv)
  show ?case
    apply simp
    unfolding steph[symmetric] apply(simp add: eval_list_disj)
    unfolding h1 apply(rule all_cong1)
    unfolding AllQ[symmetric]
    unfolding eval_neg[symmetric, of "(QE_dnf' opt step φ)"]
    unfolding opt[symmetric, of "neg(QE_dnf' opt step φ)"]
    unfolding Set.bex_simps(8)[symmetric] HOL.Not_eq_iff
    unfolding dnf_modified_eval[symmetric, of "(opt (neg(QE_dnf' opt step φ)))"]
    apply(rule bex_cong) apply simp
    subgoal for x f
      apply(cases f)
      apply (auto simp add:eval_list_conj)
      by (metis Un_iff eval.simps(1) imageI)
    done
next
  case (ExN amount φ)
  show ?case
    apply(cases amount)
    apply (simp_all add: ExN)
    unfolding steph[symmetric] apply(simp add: eval_list_disj)
    unfolding ExN[symmetric]
    unfolding opt[of "(QE_dnf' opt step φ)",symmetric]
    unfolding dnf_modified_eval[of "(opt (QE_dnf' opt step φ))",symmetric]
    apply(rule ex_cong1)
    subgoal for nat xs
      apply(cases "length xs = Suc nat")
      apply simp_all
      apply(rule bex_cong)
      apply simp_all
      subgoal for f
        apply(cases f)
        apply simp
        apply(rule ex_cong1)
        unfolding eval_list_conj
        apply auto
        by (meson Un_iff eval.simps(1) imageI)
      done
    done
next
  case (AllN amount φ)
  show ?case
    apply(cases amount)
    apply (simp_all add: AllN)
    unfolding steph[symmetric] apply(simp add: eval_list_disj)
    unfolding AllN[symmetric]
    unfolding eval_neg[symmetric, of "(QE_dnf' opt step φ)"]
    unfolding opt[symmetric, of "neg(QE_dnf' opt step φ)"]
    unfolding Set.bex_simps(8)[symmetric]
    unfolding HOL.imp_conv_disj
    unfolding HOL.de_Morgan_conj[symmetric]
    unfolding HOL.not_ex[symmetric]
    unfolding  HOL.Not_eq_iff
    unfolding dnf_modified_eval[symmetric, of "(opt (neg(QE_dnf' opt step φ)))"]
    apply(rule ex_cong1)
    subgoal for nat xs
      apply(cases "length xs = Suc nat")
      apply simp_all
      apply(rule bex_cong)
      apply simp_all
      subgoal for f
        apply(cases f)
        apply simp
        apply(rule ex_cong1)
        unfolding eval_list_conj
        apply auto
        by (meson Un_iff eval.simps(1) imageI)
      done
    done
qed auto



theorem QE_dnf_eval: 
  assumes steph : "⋀var amount new L F Γ.
  amount≤var+1 ⟹
    (∃xs. (length xs = var+1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ))) = (∃xs. (length xs = var+1 ∧eval (step amount var L F) (xs @ Γ)))"
  assumes opt : "⋀xs F . eval (opt F) xs = eval F xs"
  shows "eval (QE_dnf opt step φ) xs = eval φ xs"
proof(induction φ arbitrary:xs)
  case (Atom x)
  then show ?case by (simp add: simp_atom_eval)
next
  case (And φ1 φ2)
  then show ?case by (simp add: eval_and) 
next
  case (Or φ1 φ2)
  then show ?case by (simp add: eval_or) 
next
  case (Neg φ)
  then show ?case 
    by (metis eval.simps(6) eval_neg QE_dnf.simps(3))  
next
  case (ExQ φ)
  have h : "(∃x. ∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))).
            ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs))) = 
        (∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))). ∃x. 
            ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs)))"
    apply safe
    by blast+
  have lessThan : "⋀c. Suc 0 ≤ c + 1"
    by simp 
  show ?case apply (simp add:eval_list_disj)
    unfolding ExQ[symmetric]
    unfolding opt[symmetric, of "(QE_dnf opt step φ)"]
    unfolding dnf_modified_eval[symmetric, of "opt(QE_dnf opt step φ)"]
    unfolding h
    apply(rule bex_cong)
    apply simp
    subgoal for f
      apply(cases f)
      apply simp
      subgoal for a b c
        using steph[of "Suc 0" c a b xs, symmetric, OF lessThan] apply (simp add:eval_list_conj)
        apply safe
        subgoal for xs' l' l''
          apply(rule exI[where x="l'!c"])
          apply(rule exI[where x="take c l'"])
          apply auto
          apply (metis Un_iff append.assoc append_Cons append_Nil eval.simps(1) image_eqI lessI order_refl take_Suc_conv_app_nth take_all)
          by (metis Un_iff append.assoc append_Cons append_Nil lessI order_refl take_Suc_conv_app_nth take_all)
        subgoal for A B C D
          apply(rule exI[where x="D@[C]"]) by auto
        subgoal for A B
          apply(rule exI[where x="B@[A]"]) by auto
        done
      done
    done
next
  case (AllQ φ)
  have h : "(∃x. ∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))).
            ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs))) = 
        (∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))). ∃x. 
            ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs)))"
    apply safe
    by blast+
  have lessThan : "⋀c. Suc 0 ≤ c + 1"
    by simp 
  show ?case
    apply (simp add:eval_list_disj)
    unfolding AllQ[symmetric]
    unfolding eval_neg[symmetric, of "(QE_dnf opt step φ)"]
    unfolding opt[symmetric, of "neg(QE_dnf opt step φ)"]
    unfolding HOL.Not_eq_iff[symmetric, of "(∀f∈set (dnf_modified (opt (neg (QE_dnf opt step φ)))). ¬ eval (case f of (al, fl, n) ⇒ ExN (Suc n) (step (Suc 0) n al fl)) xs)"]
    unfolding SMT.verit_connective_def(3)[symmetric]
    unfolding boundedFlipNegQuantifier
    unfolding dnf_modified_eval[symmetric, of "opt(neg(QE_dnf opt step φ))"]
    unfolding h
    apply(rule bex_cong)
    apply simp
    subgoal for f
      apply(cases f)
      apply simp
      subgoal for a b c
        using steph[of "Suc 0" c a b xs, symmetric,OF lessThan] apply (simp add:eval_list_conj)
        apply safe
        subgoal for xs' l' l''
          apply(rule exI[where x="l'!c"])
          apply(rule exI[where x="take c l'"])
          apply auto
          apply (metis Un_iff append.assoc append_Cons append_Nil eval.simps(1) image_eqI lessI order_refl take_Suc_conv_app_nth take_all)
          by (metis Un_iff append.assoc append_Cons append_Nil lessI order_refl take_Suc_conv_app_nth take_all)
        subgoal for A B C D
          apply(rule exI[where x="D@[C]"]) by auto
        subgoal for A B
          apply(rule exI[where x="B@[A]"]) by auto
        done
      done
    done
next
  case (ExN x1 φ)
  show ?case
  proof(cases x1)
    case 0
    then show ?thesis using ExN by simp
  next
    case (Suc nat)
    have h : "(∃l. length l = Suc nat ∧
         (∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))).
             ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))) = 
        (∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))). (∃l. length l = Suc nat ∧
             (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))))"
      apply safe
      by blast+
    have lessThan : "⋀c. Suc nat ≤ c + nat + 1" by simp
    show ?thesis
      apply (simp add:eval_list_disj Suc)
      unfolding ExN[symmetric]
      unfolding opt[symmetric, of "(QE_dnf opt step φ)"]
      unfolding dnf_modified_eval[symmetric, of "(opt (QE_dnf opt step φ))"]
      unfolding h
      apply(rule bex_cong)
      apply simp
      subgoal for f
        apply(cases f)
        subgoal for a b c
          apply simp
          using steph[of "Suc nat" "c+nat",symmetric, OF lessThan]
          apply (auto simp add:eval_list_conj)
          subgoal for L
            apply(rule exI[where x="drop c L"])
            apply auto
            apply(rule exI[where x="take c L"])
            apply auto
            apply (metis Un_iff append.assoc append_take_drop_id eval.simps(1) image_eqI)
            by (metis Un_iff append.assoc append_take_drop_id)
          subgoal for L l
            apply(rule exI[where x="l@L"])
            by auto
          done
        done
      done
  qed
next
  case (AllN x1 φ)
  then show ?case 
  proof(cases x1)
    case 0
    then show ?thesis using AllN by simp
  next
    case (Suc nat)
    have h : "(∃l. length l = Suc nat ∧
         (∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))).
             ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))) = 
        (∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))). (∃l. length l = Suc nat ∧
             (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))))"
      apply safe
      by blast+
    have lessThan : "⋀c. Suc nat ≤ c + nat + 1" by simp
    show ?thesis
      apply (simp add:eval_list_disj Suc)
      unfolding AllN[symmetric]
      unfolding eval_neg[symmetric, of "QE_dnf opt step φ"]
      unfolding HOL.imp_conv_disj
      unfolding HOL.de_Morgan_conj[symmetric]
      unfolding opt[symmetric, of "neg(QE_dnf opt step φ)"]
      unfolding dnf_modified_eval[symmetric, of "(opt (neg(QE_dnf opt step φ)))"]
      unfolding HOL.Not_eq_iff[symmetric, of "(∀f∈set (dnf_modified (opt (neg (QE_dnf opt step φ)))).
        ¬ eval (case f of (al, fl, n) ⇒ ExN (Suc (n + nat)) (step (Suc nat) (n + nat) al fl)) xs)"]
      unfolding SMT.verit_connective_def(3)[symmetric]
      unfolding boundedFlipNegQuantifier
      unfolding h
      apply(rule bex_cong)
      apply simp
      subgoal for f
        apply(cases f)
        subgoal for a b c
          apply simp
          using steph[of "Suc nat" "c+nat",symmetric, OF lessThan]
          apply (auto simp add:eval_list_conj)
          subgoal for L
            apply(rule exI[where x="drop c L"])
            apply auto
            apply(rule exI[where x="take c L"])
            apply auto
            apply (metis Un_iff append.assoc append_take_drop_id eval.simps(1) image_eqI)
            by (metis Un_iff append.assoc append_take_drop_id)
          subgoal for L l
            apply(rule exI[where x="l@L"])
            by auto
          done
        done
      done
  qed
qed auto

lemma opt: "eval ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers) F) L= eval F L"
  using push_forall_eval eval_nnf unpower_eval groupQuantifiers_eval clearQuantifiers_eval by auto

lemma opt': "eval ((push_forall ( nnf ( unpower 0 ( groupQuantifiers (clearQuantifiers F)))))) L= eval F L"
  using push_forall_eval eval_nnf unpower_eval groupQuantifiers_eval clearQuantifiers_eval by auto

lemma opt_no_group: "eval ((push_forall ∘ nnf ∘ unpower 0 o clearQuantifiers) F) L= eval F L"
  using push_forall_eval eval_nnf unpower_eval clearQuantifiers_eval by auto



lemma  repeatAmountOfQuantifiers_helper_eval : 
  assumes  "⋀xs F. eval F xs = eval (step F) xs"
  shows  "eval F xs = eval (repeatAmountOfQuantifiers_helper step n F) xs"
  apply(induction n arbitrary : F)
  apply simp_all
  subgoal for n F
    using assms[of F xs] by auto
  done


lemma  repeatAmountOfQuantifiers_eval : 
  assumes  "⋀xs F. eval F xs = eval (step F) xs"
  shows  "eval F xs = eval (repeatAmountOfQuantifiers step F) xs"
proof-
  define F' where "F' = step F"
  have h:  "eval F xs = eval F' xs"
    using assms unfolding F'_def by auto
  show ?thesis
    apply (simp add: F'_def[symmetric] h)
    using repeatAmountOfQuantifiers_helper_eval[OF assms] by auto
qed

end

Theory HeuristicProofs

subsection "Heuristic Proofs"
theory HeuristicProofs
  imports VSQuad Heuristic OptimizationProofs
begin

lemma the_real_step_augment:
  assumes  steph : "⋀xs var L F Γ. length xs = var ⟹ (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (step var L F) (xs @ x # Γ))"
  shows "(∃xs. (length xs = amount ∧ eval (list_disj (map(λ(L,F,n). ExN n (list_conj (map fm.Atom L @ F))) F))  (xs @ Γ))) = (eval (the_real_step_augment step amount F)  Γ)"
proof(induction amount arbitrary: F Γ)
  case 0
  then show ?case by auto
next
  case (Suc amount)
  have h1 : "⋀F. (∃x xs. length xs = amount ∧ F (xs @ x # Γ)) = (∃xs. length xs = Suc amount ∧ F (xs @  Γ))"
    by (smt (z3) Suc_inject append.assoc append_Cons append_Nil2 append_eq_conv_conj length_append_singleton lessI self_append_conv2 take_hd_drop)

  have h2: "⋀X x Γ. (∃f∈set (dnf_modified X).
         eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) (x @ Γ)) = (∃(al, fl, n)∈set (dnf_modified X). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ (x @ Γ))) ∧ (∀f∈set fl. eval f (L @ (x @ Γ))))"
    subgoal for X x Γ
      apply(rule bex_cong)
      apply simp_all
      subgoal for f
        apply(cases f)
        apply(auto simp add:eval_list_conj)
        by (metis Un_iff eval.simps(1) imageI)
      done
    done
  have h3 : "⋀G. (∃x. ∃f∈set F. G x f) = (∃f∈set F. ∃x. G x f)"
    by blast
  show ?case
    apply simp
    unfolding Suc[symmetric]
    unfolding eval_list_disj
    apply simp
    unfolding h1[symmetric, of "λx. (∃f∈set F. eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) x)"]
    unfolding HOL.ex_comm[of "λx xs. length xs = amount ∧ (∃f∈set F. eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) (xs @ x # Γ))"]
    unfolding HOL.ex_comm[of "λx xs. length xs = amount ∧
        (∃f∈set (dnf_modified (push_forall
                     (nnf (unpower 0
                            (groupQuantifiers
                              (clearQuantifiers(list_disj (map (λ(L, F, n). ExN n (step (n + amount) L F)) F)))))))).
            eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) (xs @ x # Γ))"]
    apply(rule ex_cong1)
    apply simp
    subgoal for xs
      unfolding h2
      unfolding dnf_modified_eval 
      unfolding opt'
      unfolding eval_list_disj
      unfolding List.set_map Set.bex_simps(7)
      unfolding h3
      apply(cases "length xs = amount")
      apply (simp_all add:opt)
      apply(rule bex_cong)
      apply simp_all
      subgoal for f
        apply(cases f)
        apply simp
        subgoal for a b c
          unfolding HOL.ex_comm[of "λx l. length l = c ∧ eval (list_conj (map fm.Atom a @ b)) (l @ xs @ x # Γ)"]
          unfolding HOL.ex_comm[of "λx l. length l = c ∧ eval (step (c + amount) a b) (l @ xs @ x # Γ)"]
          apply(rule ex_cong1)
          apply simp
          subgoal for l
            apply(cases "length l = c")
            apply simp_all
            using steph[of "l @ xs" "c + amount" a b Γ]
            by simp
          done
        done
      done
    done
qed

lemma step_converter : 
  assumes  steph : "⋀xs var L F Γ. length xs = var ⟹ (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (step var L F) (xs @ x # Γ))"
  shows "⋀var L F Γ. (∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = (var + 1)) ∧ eval (step var L F) (xs @ Γ))"
proof safe
  fix var L F Γ xs
  assume h : "length xs = var + 1"
    "eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)"
  have h1 : "length (take var xs) = var" using h by auto
  have h2 : "(∃x. eval (step var L F) (take var xs @ x # Γ))"
    using h steph[OF h1]
    by (metis Cons_nth_drop_Suc One_nat_def add.right_neutral add_Suc_right append.assoc append_Cons append_Nil append_take_drop_id drop_all lessI order_refl) 
  then obtain x where h3: "eval (step var L F) (take var xs @ x # Γ)" by auto
  show "∃xs. length xs = var + 1 ∧ eval (step var L F) (xs @ Γ)"
    apply(rule exI[where x="take var xs @[x]"])
    apply (auto)
    using h(1) apply simp
    using h3 by simp
next
  fix var L F Γ xs
  assume h: "length xs = var + 1"
    "eval (step var L F) (xs @ Γ)"
  have h1 : "length (take var xs) = var" using h by auto
  have h2 : "(∃x. eval (list_conj (map fm.Atom L @ F)) (take var xs @ x # Γ))"
    using h steph[OF h1]
    by (metis Cons_nth_drop_Suc One_nat_def add.right_neutral add_Suc_right append.assoc append_Cons append_Nil append_take_drop_id drop_all lessI order_refl) 
  then obtain x where h3: "eval (list_conj (map fm.Atom L @ F)) (take var xs @ x # Γ)" by auto
  show "∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)"
    apply(rule exI[where x="take var xs @[x]"])
    apply (auto)
    using h(1) apply simp
    using h3 by simp
qed

lemma step_augmenter_eval : 
  assumes  steph : "⋀xs var L F Γ. length xs = var ⟹ (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (step var L F) (xs @ x # Γ))"
  assumes heuristic: "⋀n var L F. heuristic n L F = var ⟹ var ≤ n"
  shows "⋀var amount L F Γ.
      amount ≤ var + 1 ⟹
      (∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = (var + 1)) ∧ eval (step_augment step heuristic amount var L F) (xs @ Γ))"
  subgoal for var amount L F Γ
  proof(induction var arbitrary: L F Γ amount)
    case 0
    then have "amount = 0 ∨ amount = Suc 0" by auto
    then show ?case apply simp using steph[of "[]" 0 L F Γ] apply auto
      apply (metis append_Cons length_Cons list.size(3) self_append_conv2)
      apply (metis append_Cons length_Cons list.size(3) self_append_conv2)
      apply (metis Suc_length_conv append_Cons length_0_conv self_append_conv2)
      by (metis Suc_length_conv append_Cons append_self_conv2 length_0_conv)
  next
    case (Suc var)
    define heu where "heu = heuristic (Suc var) L F"
    have heurange : "heu ≤ Suc var" unfolding heu_def
      by (simp add: heuristic)
    have lessThan1 : "1 ≤ var + 1" by auto 

    {
      fix amount
      assume amountLessThan: "amount ≤ var + 1"
      have "(∃xs. length xs = Suc (Suc var) ∧
          eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. length xs = Suc (Suc var) ∧
          eval
           (step (Suc var) (map (swap_atom (Suc var) heu) L)
             (map (swap_fm (Suc var) heu) F))
           (xs @ Γ))"
      proof(safe)
        fix xs
        assume h: "length (xs::real list) = Suc (Suc var)" "eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)"
        then have length : "length (take (Suc var) (swap_list (Suc var) heu xs)) = Suc var" by auto
        have take: "(take (Suc var) (swap_list (Suc var) heu xs) @ xs ! heu # Γ) = (swap_list (Suc var) heu (xs @ Γ)) " using h(1)
          unfolding swap_list.simps 
          by (smt (verit, ccfv_threshold) Cons_nth_drop_Suc append.right_neutral append_Nil2 append_assoc append_eq_conv_conj append_self_conv2 append_take_drop_id drop0 heu_def heurange le_imp_less_Suc length_greater_0_conv length_list_update lessI list.sel(1) list.sel(3) list.simps(3) list.size(3) list_update_append nth_Cons_0 nth_append nth_append_length nth_list_update_eq take0 take_hd_drop)
        have length1 : "Suc var < length (xs @ Γ)" using h by auto
        have length2 : "heu < length (xs @ Γ)" using h heurange by auto
        have h1: "(∃x. eval
        (step (Suc var) (map (swap_atom (Suc var) heu) L)
          (map (swap_fm (Suc var) heu) F))
        (take (Suc var) (swap_list (Suc var) heu xs) @ x # Γ))"
          unfolding steph[OF length, symmetric]
          apply(rule exI[where x="nth xs heu"])
          using h unfolding eval_list_conj take apply (auto simp del:swap_list.simps)
          unfolding swap_fm[OF length1 length2,symmetric] swap_atom[OF length1 length2,symmetric]
          by (meson UnCI eval.simps(1) imageI)+
        then obtain x where heval: "eval
       (step (Suc var) (map (swap_atom (Suc var) heu) L)
         (map (swap_fm (Suc var) heu) F))
       (take (Suc var) (swap_list (Suc var) heu xs) @ x # Γ)" by auto
        show "∃xs. length xs = Suc (Suc var) ∧
               eval
                (step (Suc var) (map (swap_atom (Suc var) heu) L)
                  (map (swap_fm (Suc var) heu) F))
                (xs @ Γ)"
          apply(rule exI[where x="take (Suc var) (swap_list (Suc var) heu xs) @ [x]"])
          apply auto
          using h apply simp
          using heval by auto
      next
        fix xs
        assume h : "length xs = Suc (Suc var)""
          eval
           (step (Suc var) (map (swap_atom (Suc var) heu) L)
             (map (swap_fm (Suc var) heu) F))
           (xs @ Γ)"
        define choppedXS where "choppedXS = take (Suc var) xs"
        then have length : "length choppedXS = Suc var"
          using h(1) by force
        have "(∃x. eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (choppedXS @ x # Γ))"
          using h(2) choppedXS_def
          by (metis append.assoc append_Cons append_Nil2 append_eq_conv_conj h(1) lessI take_hd_drop) 
        then have "∃x. (∀l∈ set L. aEval (swap_atom (Suc var) heu l) (choppedXS@x#Γ)) ∧ (∀f∈ set F. eval (swap_fm (Suc var) heu f) (choppedXS@x#Γ))"
          unfolding steph[symmetric, OF length, of "(map (swap_atom (Suc var) heu) L)" "(map (swap_fm (Suc var) heu) F)" Γ] eval_list_conj apply auto
          by (metis Un_iff eval.simps(1) imageI)
        then obtain x where x : "(∀l∈set L. aEval (swap_atom (Suc var) heu l) (choppedXS @ x # Γ)) ∧
      (∀f∈set F. eval (swap_fm (Suc var) heu f) (choppedXS @ x # Γ))" by auto
        have length1 : "Suc var < length (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)"
          by (simp add: length)
        have length2 : "heu < length (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)"
          using ‹Suc var < length (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)› heurange by linarith
        have swapswap : "(swap_list (Suc var) heu (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)) = (choppedXS @ [x]) @ Γ" apply auto
          by (smt (z3) Cons_nth_drop_Suc append_eq_conv_conj append_same_eq heurange id_take_nth_drop le_neq_implies_less length length1 length_append_singleton lessI list.sel(1) list_update_append1 list_update_length list_update_swap nth_append nth_append_length nth_list_update_neq swap_list.simps take_hd_drop take_update_swap upd_conv_take_nth_drop)
        show "∃xs. length xs = Suc (Suc var) ∧
               eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)"
          apply(rule exI[where x="swap_list (Suc var) heu (choppedXS @ [x])"])
          apply(auto simp add: eval_list_conj simp del: swap_list.simps)
          apply(simp add :length)
          unfolding swap_atom[OF length1 length2] swap_fm[OF length1 length2] swapswap
          using x by auto
      qed
      also have "... = (∃xs. length xs = Suc (Suc var) ∧
          (∃f∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L)
                          (map (swap_fm (Suc var) heu) F)))).
              eval (case f of (x, xa) ⇒ step_augment step heuristic amount var x xa)
               (xs @ Γ)))"
        unfolding opt[of "(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F))", symmetric]
        unfolding dnf_eval[of "(push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L)
             (map (swap_fm (Suc var) heu) F))", symmetric]
      proof(safe)
        fix xs a b
        assume h: "length xs = Suc (Suc var)""
       (a, b)
       ∈ set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L)
                     (map (swap_fm (Suc var) heu) F)))) ""
       ∀a∈set a. aEval a (xs @ Γ) ""
       ∀f∈set b. eval f (xs @ Γ)"
        have "(∃xs'. length xs' = var + 1 ∧
        eval (step_augment step heuristic amount var a b) (xs' @ xs ! Suc var # Γ))"
          unfolding Suc(1)[of amount a b "nth xs (Suc var)#Γ", OF amountLessThan, symmetric]
          apply(rule exI[where x="take (Suc var) xs"])
          using h(1) h(3-4) apply(auto simp add: eval_list_conj)
          apply (metis Cons_nth_drop_Suc append_Cons append_eq_append_conv2 append_eq_conv_conj append_take_drop_id lessI)
          by (metis Cons_nth_drop_Suc append_Cons append_eq_append_conv2 append_eq_conv_conj append_take_drop_id lessI)
        then obtain xs' where xs': "length xs' = var + 1" "eval (step_augment step heuristic amount var a b) (xs' @ xs ! Suc var # Γ)"
          by auto

        show "∃xs. length xs = Suc (Suc var) ∧
            (∃f∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L)
                            (map (swap_fm (Suc var) heu) F)))).
                eval (case f of (x, xa) ⇒ step_augment step heuristic amount var x xa)
                 (xs @ Γ))"
          apply(rule exI[where x="xs' @[ xs ! Suc var]"])
          apply auto
          using xs' apply simp
          apply(rule bexI[where x="(a,b)"])
          using xs' h apply(cases amount) apply (simp_all add:eval_list_conj)
          using h(2) by auto
      next
        fix xs a b
        assume h: "length xs = Suc (Suc var) ""
       (a, b)
       ∈ set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L)
                     (map (swap_fm (Suc var) heu) F)))) ""
       eval (step_augment step heuristic amount var a b) (xs @ Γ)"
        have "(∃xs'. length xs' = var + 1 ∧
        eval (list_conj (map fm.Atom a @ b)) (xs' @ xs ! Suc var # Γ))"
          unfolding Suc(1)[of amount a b "nth xs (Suc var)#Γ", OF amountLessThan]
          apply(rule exI[where x="take (Suc var) xs"])
          using h(1) h(3) apply auto
          by (metis Cons_nth_drop_Suc append.right_neutral append_Cons append_assoc append_eq_conv_conj append_self_conv2 append_take_drop_id lessI)
        then obtain xs' where xs': "length xs' = var + 1" " eval (list_conj (map fm.Atom a @ b)) (xs' @ xs ! Suc var # Γ)"
          by auto
        show "∃xs. length xs = Suc (Suc var) ∧
            (∃(al, fl)
              ∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L)
                           (map (swap_fm (Suc var) heu) F)))).
                (∀a∈set al. aEval a (xs @ Γ)) ∧
                (∀f∈set fl. eval f (xs @ Γ)))"
          apply(rule exI[where x="xs' @[ xs ! Suc var]"])
          apply auto
          using xs' apply simp
          apply(rule bexI[where x="(a,b)"])
          using xs' h apply (simp_all add: eval_list_conj)
        proof -
          assume "∀f∈fm.Atom ` set a ∪ set b. eval f (xs' @ xs ! Suc var # Γ)"
          then have "∀f. f ∈ fm.Atom ` set a ∪ set b ⟶ eval f (xs' @ xs ! Suc var # Γ)"
            by meson
          then have f1: "v ∉ set a ∨ eval (fm.Atom v) (xs' @ xs ! Suc var # Γ)" for v
            by blast
          obtain aa :: atom where
            "(∃v0. v0 ∈ set a ∧ ¬ eval (fm.Atom v0) (xs' @ xs ! Suc var # Γ)) = (aa ∈ set a ∧ ¬ eval (fm.Atom aa) (xs' @ xs ! Suc var # Γ))"
            by blast
          then show "∀a∈set a. aEval a (xs' @ xs ! Suc var # Γ)"
            using f1 eval.simps(1) by auto
        qed

      qed
      finally have "(∃xs. length xs = Suc (Suc var) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
  (∃xs. length xs = Suc (Suc var) ∧
        (∃f∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers) (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))).
            eval (case f of (x, xa) ⇒ step_augment step heuristic amount var x xa) (xs @ Γ)))"
        by auto 
    }then show ?case apply(cases amount) using Suc(2)  by (simp_all add:eval_list_disj heu_def[symmetric])
  qed
  done

lemma qe_eq_repeat_eval_augment : "amount ≤ var+1 ⟹
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (step_augment qe_eq_repeat IdentityHeuristic amount var L F) (xs @ Γ))"
  apply(rule step_augmenter_eval[of qe_eq_repeat IdentityHeuristic amount var L F Γ])
  using qe_eq_repeat_eval apply blast by auto

lemma qe_eq_repeat_eval' : "
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (qe_eq_repeat var L F) (xs @ Γ))"
  apply(rule step_converter[of qe_eq_repeat var L F Γ])
  using qe_eq_repeat_eval by blast

lemma gen_qe_eval_augment : "amount ≤ var+1 ⟹
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (step_augment gen_qe IdentityHeuristic amount var L F) (xs @ Γ))"
  apply(rule step_augmenter_eval[of gen_qe IdentityHeuristic amount var L F Γ])
  using gen_qe_eval apply blast by auto

lemma gen_qe_eval' : "
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (gen_qe var L F) (xs @ Γ))"
  apply(rule step_converter[of gen_qe var L F Γ])
  using gen_qe_eval by blast

lemma luckyFind_eval_augment : "amount ≤ var+1 ⟹
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (step_augment luckyFind' IdentityHeuristic amount var L F) (xs @ Γ))"
  apply(rule step_augmenter_eval[of luckyFind' IdentityHeuristic amount var L F Γ])
  using luckyFind'_eval apply blast by auto

lemma luckyFind_eval' : "
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (luckyFind' var L F) (xs @ Γ))"
  apply(rule step_converter[of luckyFind' var L F Γ])
  using luckyFind'_eval by blast

lemma luckiestFind_eval' : "
      (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = var + 1) ∧ eval (luckiestFind var L F) (xs @ Γ))"
  apply(rule step_converter[of luckiestFind var L F Γ])
  using luckiestFind_eval by blast


lemma sortedListMember : "sorted_list_of_fset b = var # list ⟹ fmember var b "
  by (metis fset_of_list_elem list.set_intros(1) sorted_list_of_fset_simps(2))

lemma rangeHeuristic : 
  assumes "heuristicPicker n L F = Some (var, step)"
  shows "var≤n"
proof(cases "aquireData n L")
  case (fields a b c)
  then show ?thesis using assms apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases "getBest a L")
    apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases F) apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases "getBest c L") apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases "getBest b L")apply(simp_all del: aquireData.simps getBest.simps)
    apply (metis not_le_imp_less option.distinct(1) option.inject prod.inject)
    apply (metis not_le_imp_less option.distinct(1) option.inject prod.inject)
    apply(cases "getBest b L")apply(simp_all del: aquireData.simps getBest.simps)
    by (metis not_le_imp_less option.distinct(1) option.inject prod.inject)+
qed

lemma pickedOneOfThem : 
  assumes "heuristicPicker n L F = Some (var, step)"
  shows "step = qe_eq_repeat ∨ step = gen_qe ∨ step = luckyFind'"
  using assms
  apply(cases "aquireData n L")
  subgoal for l e g
    using assms apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases "getBest l L")
    apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases F) apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases "getBest g L") apply(simp_all del: aquireData.simps getBest.simps)
    apply(cases "getBest e L")apply(simp_all del: aquireData.simps getBest.simps)
    apply (metis option.distinct(1) option.inject prod.inject)
    apply (metis option.distinct(1) option.inject prod.inject)
    apply(cases "getBest e L")apply(simp_all del: aquireData.simps getBest.simps)
    by (metis  option.distinct(1) option.inject prod.inject)+
  done

lemma superPicker_eval : 
  "amount≤ var+1 ⟹ (∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
      (∃xs. (length xs = (var + 1)) ∧ eval (superPicker amount var L F) (xs @ Γ))"
proof(induction var arbitrary : L F Γ amount)
  case 0
  then show ?case apply(simp del:heuristicPicker.simps)
    apply(cases "heuristicPicker 0 L F") apply(cases amount)
    apply (simp_all del:heuristicPicker.simps)
    subgoal for a
      apply(cases a)
      apply (simp_all del:heuristicPicker.simps)
      subgoal for var step
        apply(cases var) apply(cases amount)
        apply(simp_all del:heuristicPicker.simps) 
      proof-
        assume h: "heuristicPicker 0 L F = Some (0, step)"
        show "(∃xs. length xs = Suc 0 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
    (∃xs. length xs = Suc 0 ∧ eval (step 0 L F) (xs @ Γ)) "
          using pickedOneOfThem[OF h]
          using  qe_eq_repeat_eval'[of 0 L F Γ] gen_qe_eval'[of 0 L F Γ] luckyFind_eval'[of 0 L F Γ]
          by auto
      next
        show "⋀nat. amount ≤ Suc 0 ⟹
           heuristicPicker 0 L F = Some (Suc nat, step) ⟹
           a = (Suc nat, step) ⟹
           var = Suc nat ⟹
           (∃xs. length xs = Suc 0 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
           (∃xs. length xs = Suc 0 ∧ eval (superPicker amount 0 L F) (xs @ Γ)) "
          apply(cases amount) by(simp_all del:heuristicPicker.simps) 
      qed
      done
    done
next
  case (Suc i)
  then show ?case apply(cases "heuristicPicker (Suc i) L F") apply(cases amount)
    apply(simp_all del:heuristicPicker.simps)
    subgoal for a
      apply(cases a)
      apply(simp_all del:heuristicPicker.simps) apply(cases amount) apply simp
      apply(cases amount) apply(simp_all del:heuristicPicker.simps)
      subgoal for var step amountPred amountPred' 
      proof-
        assume amountPred : "amountPred ≤ Suc i"
        assume ih: "(⋀amount L F Γ.
        amount ≤ Suc i ⟹
        (∃xs. length xs = Suc i ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) =
        (∃xs. length xs = Suc i ∧ eval (superPicker amount i L F) (xs @ Γ)))"
        assume h0 : "heuristicPicker (Suc i) L F = Some (var, step)"
        have h1: "⋀xs X F. (∃f∈set (map (λ(x, y). F x y)
                     (dnf X)).
              eval f (xs)) = (∃(al,fl)∈set(dnf X).
              eval (F al fl) (xs))"
          subgoal for xs X F
            apply auto
            subgoal for a b
              apply(rule bexI[where x="(a,b)"])
              apply simp_all
              done
            done
          done
        have eval_map : "⋀al fl xs Γ.(∀f∈set (map fm.Atom al @ fl). eval f (xs @ Γ)) = ((∀a∈set al. aEval a (xs @ Γ)) ∧ (∀f∈set fl. eval f (xs @ Γ)))"
          apply auto
          by (meson Un_iff eval.simps(1) imageI)
        have rearangeExists :  "⋀ X F.((∃xs. length xs = Suc (Suc i) ∧
               (∃(al, fl)∈set (dnf X). F al fl xs)) =
            (∃(al,fl)∈set (dnf X).(∃xs. length xs = Suc (Suc i) ∧
                F al fl xs)))"
          by blast
        have dropTheEnd : "⋀F Γ.(∃xs. length xs = Suc (Suc i) ∧ F (xs @ Γ)) = (∃x. (∃xs. length xs = i+1 ∧ F (xs @ x#Γ)))"
          apply(safe)
          subgoal for F Γ xs
            apply(rule exI[where x="nth xs (i+1)"])
            apply(rule exI[where x="take (i+1) xs"]) apply auto
            by (metis Cons_nth_drop_Suc append.right_neutral append_Cons append_assoc append_eq_conv_conj append_self_conv2 append_take_drop_id lessI)
          subgoal for F Γ x xs
            apply(rule exI[where x="xs@[x]"])
            by auto
          done
        have h2 : "⋀X Γ amount. amount≤ Suc i ⟹((∃xs. length xs = Suc (Suc i) ∧
          (∃(al, fl)∈set (dnf X).
              eval (superPicker amount i al fl) (xs @ Γ)))
          = (∃xs. length xs = Suc (Suc i) ∧
          (∃(al, fl)∈set (dnf X).
              (∀a∈set al. aEval a (xs@Γ))∧(∀f∈set fl. eval f (xs@Γ)))))"
          subgoal for X Γ amount
            unfolding rearangeExists
            apply(rule bex_cong)
            apply simp
            subgoal for x
              apply (cases x)
              apply simp
              subgoal for al fl
                unfolding dropTheEnd 
                unfolding dropTheEnd[of"λxs. (∀a∈set al. aEval a xs) ∧ (∀f∈set fl. eval f xs)"]
                apply simp
                unfolding ih[of amount al fl "_#Γ",symmetric]
                unfolding eval_list_conj
                apply(rule ex_cong1)
                subgoal for xa
                  apply(rule ex_cong1)
                  subgoal for xab apply auto
                    by (meson Un_iff eval.simps(1) image_eqI)
                  done
                done
              done
            done
          done
        have h3 : "⋀L F. (∃xs. length xs = Suc (Suc i) ∧ eval (step (Suc i) L F) (xs@Γ)) = (∃xs. length xs = Suc (Suc i) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ))"
          subgoal for L F
            using pickedOneOfThem[OF h0]
            using  qe_eq_repeat_eval'[of "Suc i" L F Γ] gen_qe_eval'[of "Suc i" L F Γ] luckyFind_eval'[of "Suc i" L F Γ]
            by auto
          done
        have heurange : "var≤ Suc i" using rangeHeuristic[OF h0] by auto
        show ?thesis
          unfolding eval_list_disj
          unfolding h1
          unfolding h2[OF amountPred]
          unfolding dnf_eval 
          unfolding opt'
          unfolding h3 
        proof(safe)
          fix xs
          assume h : "length xs = Suc (Suc i)" "eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)"
          have h3 : "var < length (xs @ Γ)"  using h heurange by auto
          have h1: "(swap_list (Suc i) var (xs @ Γ)) = (swap_list (Suc i) var xs @ Γ)"
            using h(1) heurange apply simp
            by (simp add: list_update_append nth_append)
          have h2 : "Suc i < length (xs @ Γ)" using h by auto

          show "∃xs. length xs = Suc (Suc i) ∧
               eval (list_conj (map fm.Atom (map (swap_atom (Suc i) var) L) @ map (swap_fm (Suc i) var) F)) (xs @ Γ)"
            apply(rule exI[where x="swap_list (Suc i) var xs"])
            apply(auto simp add:h eval_list_conj simp del:swap_list.simps)
            apply(simp add: h)
            using swap_fm[OF h2 h3] swap_atom[OF h2 h3] unfolding h1
            using h(2) unfolding eval_list_conj
            apply auto

            by (meson Un_iff eval.simps(1) imageI)
        next
          fix xs
          assume h : "length xs = Suc (Suc i)""eval (list_conj (map fm.Atom (map (swap_atom (Suc i) var) L) @ map (swap_fm (Suc i) var) F)) (xs @ Γ)"
          have h3 : "var < length (swap_list (Suc i) var xs @ Γ)"  using h heurange by auto
          have h1: "swap_list (Suc i) var (swap_list (Suc i) var xs @ Γ) = xs @ Γ"
            apply auto
            using h(1) heurange
            by (smt (z3) le_imp_less_Suc length_list_update lessI list_update_append list_update_id list_update_overwrite list_update_swap nth_append nth_list_update_eq)
          have h2 : "Suc i < length (swap_list (Suc i) var xs @ Γ)" using h by auto
          show "∃xs. length xs = Suc (Suc i) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)"
            apply(rule exI[where x="swap_list (Suc i) var xs"])
            apply(auto simp add:eval_list_conj simp del:swap_list.simps)
            apply(simp add: h)
            unfolding swap_fm[OF h2 h3] swap_atom[OF h2 h3]
            unfolding h1
            using h(2) unfolding eval_list_conj
            apply auto
            apply (meson Un_iff eval.simps(1) imageI)
            done
        qed
      qed
      done
    done
qed 


lemma brownHueristic_less_than: "brownsHeuristic n L F = var ⟹ var≤ n"
  apply simp
  apply(cases "sorted_list_of_fset
           ((λx. case foldl
                        (λ(maxdeg, totaldeg, appearancecount) l.
                            let deg = MPoly_Type.degree (case l of Less p ⇒ p | Eq p ⇒ p | Leq p ⇒ p | Neq p ⇒ p) x
                            in (max maxdeg deg, totaldeg + deg, appearancecount + (if 0 < deg then 1 else 0)))
                        (0, 0, 0) L of
                  (a, b, c) ⇒ Quad (a, b, c, x)) |`|
            fset_of_list [0..<n])")
  apply auto
  subgoal for a apply(cases a)
    by auto
  done
end

Theory ExportProofs

subsection "Top-Level Algorithm Proofs"
theory ExportProofs
  imports HeuristicProofs Exports
    (*"HOL-Library.Code_Real_Approx_By_Float"*)
    HOL.String "HOL-Library.Code_Target_Int" "HOL-Library.Code_Target_Nat" PrettyPrinting Show.Show_Real
begin


theorem "eval (Unpower f) L = eval f L" unfolding unpower_eval Unpower_def by auto


theorem VSLuckiest: "∀xs. eval (VSLuckiest φ) xs = eval φ xs"
  unfolding VSLuckiest_def Unpower_def opt_def
  using QE_dnf_eval[OF luckiestFind_eval' opt_no_group] opt_no_group
  by fastforce

theorem VSLuckiestBlocks : "∀xs. eval (VSLuckiestBlocks φ) xs = eval φ xs"
  unfolding VSLuckiestBlocks_def Unpower_def opt_group_def
  using QE_dnf'_eval[OF the_real_step_augment[OF luckiestFind_eval, of "λx _ _. x"] opt]
  using opt
  by fastforce

theorem VSEquality : "∀xs. eval (VSEquality φ) xs = eval φ xs"
  unfolding VSEquality_def Unpower_def opt_def
  using QE_dnf_eval[OF qe_eq_repeat_eval' opt_no_group]
  using  opt_no_group VSLuckiest
  by fastforce


theorem VSEqualityBlocks : "∀xs. eval (VSEqualityBlocks φ) xs = eval φ xs"
  unfolding VSEqualityBlocks_def Unpower_def opt_group_def
  using QE_dnf'_eval[OF the_real_step_augment[OF qe_eq_repeat_eval, of "λx _ _. x"] opt]
  using opt VSLuckiestBlocks
  by fastforce

theorem VSGeneralBlocks : "∀xs. eval (VSGeneralBlocks φ) xs = eval φ xs"
  unfolding VSGeneralBlocks_def Unpower_def opt_group_def
  using QE_dnf'_eval[OF the_real_step_augment[OF gen_qe_eval, of "λx _ _. x"] opt]
  using opt VSLuckiestBlocks
  by fastforce

theorem VSLuckyBlocks : "∀xs. eval (VSLuckyBlocks φ) xs = eval φ xs"
  unfolding VSLuckyBlocks_def Unpower_def opt_group_def
  using QE_dnf'_eval[OF the_real_step_augment[OF luckyFind'_eval, of "λx _ _. x"] opt]
  using opt VSLuckiestBlocks
  by fastforce

theorem VSLEGBlocks : "∀xs. eval (VSLEGBlocks φ) xs = eval φ xs"
  unfolding VSLEGBlocks_def opt_group_def
  using VSEqualityBlocks VSGeneralBlocks VSLuckyBlocks
  by fastforce

theorem VSEqualityBlocksLimited : "∀xs. eval (VSEqualityBlocksLimited φ) xs = eval φ xs"
  unfolding VSEqualityBlocksLimited_def Unpower_def opt_group_def
  using QE_dnf_eval[OF qe_eq_repeat_eval_augment opt] opt VSLuckiestBlocks
  by fastforce


theorem VSEquality_3_times : "∀xs. eval (VSEquality_3_times φ) xs = eval φ xs"
  using VSEquality unfolding VSEquality_3_times_def by auto

theorem VSGeneral:  "∀xs. eval (VSGeneral φ) xs = eval φ xs"
  unfolding VSGeneral_def Unpower_def Unpower_def opt_def
  using QE_dnf_eval[OF gen_qe_eval' opt_no_group]
  using  opt_no_group VSLuckiest
  by fastforce

theorem VSGeneralBlocksLimited:  "∀xs. eval (VSGeneralBlocksLimited φ) xs = eval φ xs"
  unfolding VSGeneralBlocksLimited_def Unpower_def opt_group_def
  using QE_dnf_eval[OF gen_qe_eval_augment opt] opt VSLuckiestBlocks
  by fastforce

theorem VSBrowns:  "∀xs. eval (VSBrowns φ) xs = eval φ xs"
  unfolding VSBrowns_def Unpower_def opt_group_def
  using QE_dnf_eval[OF step_augmenter_eval[of gen_qe brownsHeuristic, OF gen_qe_eval brownHueristic_less_than] opt] opt VSLuckiestBlocks
  by fastforce


theorem VSGeneral_3_times : "∀xs. eval (VSGeneral_3_times φ) xs = eval φ xs"
  unfolding  VSGeneral_3_times_def  using VSGeneral
  by auto

theorem VSLucky: "∀xs. eval (VSLucky φ) xs = eval φ xs"
  unfolding VSLucky_def Unpower_def opt_def
  using QE_dnf_eval[OF luckyFind_eval' opt_no_group] opt_no_group VSLuckiest
  by fastforce

theorem VSLuckyBlocksLimited: "∀xs. eval (VSLuckyBlocksLimited φ) xs = eval φ xs"
  unfolding VSLuckyBlocksLimited_def Unpower_def opt_group_def
  using QE_dnf_eval[OF luckyFind_eval_augment opt] opt VSLuckiestBlocks
  by fastforce

theorem VSLEG: "∀xs. eval (VSLEG φ) xs = eval φ xs"
  unfolding VSLEG_def
  using VSLucky VSEquality VSGeneral by auto

theorem VSHeuristic : "∀xs. eval(VSHeuristic φ) xs = eval φ xs"
  unfolding VSHeuristic_def Unpower_def opt_group_def
  using QE_dnf_eval[OF superPicker_eval opt] opt VSLuckiestBlocks
  by fastforce


theorem VSLuckiestRepeat : "∀xs. eval (VSLuckiestRepeat φ) xs = eval φ xs"
  unfolding VSLuckiestRepeat_def using repeatAmountOfQuantifiers_eval[OF] using VSLuckiest
  by blast 


export_code
  print_mpoly
  VSGeneral VSEquality VSLucky VSLEG VSLuckiest
  VSGeneralBlocksLimited VSEqualityBlocksLimited VSLuckyBlocksLimited 
  VSGeneralBlocks VSEqualityBlocks VSLuckyBlocks VSLEGBlocks VSLuckiestBlocks
  QE_dnf
  gen_qe qe_eq_repeat
  simpfm push_forall nnf Unpower
  is_quantifier_free is_solved
  add mult C V pow minus
  Eq Or is_quantifier_free 

real_of_int real_mult real_div real_plus real_minus

VSGeneral_3_times VSEquality_3_times VSHeuristic VSLuckiestRepeat VSBrowns
in SML module_name VS




end